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METHOD FOR LOCATING A RADIO FREQUENCY EMITTER 



BACKGROUND OF THE INVENTION 

This invention relates to a method for locating a radio frequency emitter that transmits pulses in a swept 
beam pattern. 

6 In electronic warfare applications, the need arises to locate a radio frequency emitter that transmits 
pulses in a swept beam. Such a swept beam is usually produced by a rotating antenna, but could also be 
produced by an oscillating antenna. Current techniques for locating such an emitter require that the 
observation point lie in the line of sight of the emitter. This requirement means that an emitter can only be 
located when the observation point is exposed to attack from the emitter. The accuracy of some current 

10 techniques for locating a radio frequency emitter also depends upon precise angle measurements, which 
may be difficult to obtain. 

SUMMARY OF THE INVENTION 

15 

The invention is a method for locating a radio frequency emitter at an observation point that does not 
have to be in a direct line of sight from the emitter by using terrain intervisibillty data and the relative times 
of arrival of signals from a single pulse reflected from different points on the terrain at the observation point. 
The emitter transmits pulses in a regular swept beam pattern. As a result of this regular pattern, the angles 

20 of transmission of the pulses can be inferred. Intervisibillty data of terrain points in a region around the 
observation point are stored in computer memory. At the observation point, measurements are made of the 
times of arrival of a plurality of terrain point reflections of a single pulse transmitted by the emitter. These 
measurements are repeated for a plurality of pulses transmitted by the emitter. In a computer, a comparison 
is made of the terrain points of reflection calculated from the measured times of arrival for candidate, i.e., 

25 assumed emitter locations with the stored Intervisibility data of terrain points. Precise angle measurements 
are not required to locate a radio frequency emitter in this way. 

BRIEF DESCRIPTION OF THE DRAWINGS 

30 

The features of a specific embodiment of the best mode contemplated of carrying out the invention are 
illustrated In the drawings, in which: 

FIGS. 1 to 3 are diagrams illustrating spatial considerations used to explain the Invention; 
FiGS. 4 and 5 are waveforms illustrating time relationships used to explain the invention; 
35 FIG, 6 is a schematic block diagram of apparatus for practicing the invention; 

FIG. 7 is a schematic block diagram that illustrates the data used by a computer to locate an emitter 
in accordance with the principles of the invention; and 

FIGS. 8A, 8B, 8C and 8D are diagrams representing the feasibility of various emitter locations. 

40 

DETAILED DESCRIPTION OF THE SPECIFIC EMBODIMENT 

FIG. 1 is a schematic plan view of a terrain based emitter 10 to be located relative to an observation 
45 point 12. It is assumed that emitter 10 rotates at a constant angular velocity of 30* per second and 
transmits pulsed radio frequency waves, e.g., at 1.344 gigahertz, with a pulse repetition rate, e.g., of 450 
pulses per second. It is also assumed that emitter 10 has a directional radiation pattern with a narrow main 
beam or lobe, e.g., 2" to 3\ and lower Intensity side lobes. It Is further assumed that the altitude of emitter" 
10 and observation point 12 through ground reflections and the terrain altitude therebetween is such that 
50 observation point 12 is not in a direct line of sight from emitter 10, i.e., observation point 12 Is below the 
line of sight of emitter 10. 

Observation point 12 could be a low flying aircraft, a ground site, or a ship on water. When the main 
beam of emitter 10 is not directed at observation point 12, some of the radio frequency energy from the 
side lobes reaches observation point 12 through ground reflections in a direct line, as depicted by the 
broken line in FIG. 1 . Some of the radio frequency energy from the main beam also reaches observation , 
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point 12 after lateral reflection from terrain points, such as a point 14, as depicted by the unbroken line In 
FIG. 1, Thus, each pulse transmitted by emitter 10 reaches observation point 12 in the direct line path and 
thereafter reaches observation point 12 from a number of laterally reflective paths via various terrain points 
such as point 14. The time delays between the direct line pulse and the reflected pulses received at 

5 observation point 12 are indicative of the specific terrain points from which the delayed pulses are reflected. 
The longer the transmission path from emitter 10 to the terrain point of reflection and from there to 
observation point 12, the longer the time delay. 

By analyzing the radio frequency energy received at observation point 12 from emitter 10. the angular 
velocity at which emitter 10 rotates, its pulse repetition rate, and its direction from observation point 12 as a 

70 function of time can be determined. Specifically, an extraordinarily large radio frequency energy pulse, 
hereafter called Peak of Beam (POB), is received at observation point 12 when the main beam of emitter 10 
transmits in a direct line to observation point 12. Treating this direct line, i.e., the broken line in FIG. 1, as 
the angular reference for rotation of emitter 10, the approximate angular position of the main beam of 
emitter 10 at the time of reception of each direct line pulse at observation point 12 can be inferred. This 

15 pulse Is, in general, detectable even though the observer does not have direct line of sight to the emitter. 
Thus, assuming counterclockwise rotation of emitter 10, after 675 pulses from POB, emitter 10 is at an 
angle of 45* and after 1350 pulses from POB, emitter 10 is at an angle of 90\ 

In FIG. 2, point 0 represents observation point 12 and points Ei and Ea represent two emitter locations 
in the same direction from observation point 12 in a rectangular coordinate system having an I axis and a J 

20 axis. The coordinate system is defined so point 0 is at the origin and points Ei and Ez are on the J axis. A 
given pulse transmitted when the main beam is at an angle d and arriving at point O after a specified time 
delay would be reflected from a terrain point Fi if emitter 10 were located at point Ei and would be 
reflected from a terrain point Fa if emitter 10 were located at point Ea. Thus, for a particular angle Q, and a 
specified time delay, there is a locus of possible terrain points, represented as a line 16 corresponding to 

25 the possible emitter locations. For the particular angle 9 and time delays there are different loci of terrain 
points, shifting downward and to the right in FIG. 2 with increasing time delay. 

In FIG. 3, a single emitter location E is assumed. The distance between points E and 0, which defines 
the emitter location relative to observation point 12, is represented by a distance r. d is the angle of the 
main beam at the time of pulse transmission, I is one coordinate of a terrain point of reflection, and J is the 

30 other coordinate of the same terrain point of reflection. For a specific location of emitter 10, i.e., point E. and 
a variable angle 9, the locus of possible terrain points from which a reflected pulse could reach observation 
point 12, after a given time delay relative to a directly transmitted pulse is defined by an ellipse, as 
illustrated in FIG. 2, because the reflected transmission paths for ail such terrain paths are the same. Thus, 
the delayed pulses received at observation point 12 correspond to ellipses increasing in size about points O 

35 and E with increasing time delay. This relationship is expressed by the equation: 

(^-■^/^'^ + i^L — _ = 1 (1) 

(r + D)-' (r + D)^ - 
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where the difference between each reflected transmission path, i.e., the sum of the distance from point E to 
a point (I. J) and the distance from such point (1, J) to point O. and the direct transmission path r equals D. 
The pulse time delay, t , equals D divided by the speed of light. 

Furthermore, since the distance r equals the sum of the distance from point O to point (I, J) J and the 
distance from point J to point E. the relationship among 1, J, r and d can be expressed by the following 
equation: 

Y = r - X cot 9 (2) 

From equations (1) and (2), the coordinates of a point of reflection can be expressed in terms of the 
distance r, the angle of the main beam 6 , and D, the difference between the reflected and direct 
transmission paths from point E to point 0 as follows: 



55 



3 



EP 0 342 529 A2 



(r + D/2) sin 9 



X « 



1 + r/D (1 - cos 8) 



(3) 



6 



X 



10 



15 



(r + D/2) cos e 



Y = 



(4) 



1 + r/D (1 - cos 8 ) 



The additional information about emitter location that can be obtained from delays due to terrain 
reflections for successive pulses from the emitter at the assumed pulse repetition rate is not significant. 
Therefore, only a fraction of the pulses transmitted by the emitter are ordinarily processed in the practice of 
the invention. By way of example, every 30th pulse transmitted by the emitter could be processed* Thus, 
for every 2* rotation of d, a set of time delay data is collected. 

FIG. 4 represents the directly transmitted pulses from the emitter received at the observation point. 
Large pulses 18 represent the POB pulses transmitted at twelve second intervals. Pulses 20 represent the 
pulses directly transmitted at successive angular positions of the emitter between the POB pulses. For the 
assumed emitter characteristics, 5,400 pulses 20 appear between successive pulses 18. Each 30th pulse 20 
is processed to derive information about the emitter location during a sampling interval T, e.g., 600 
microseconds, which is less than the period between pulses 20. 

FIG. 5 represents the radio frequency energy from a single pulse received at the observation point from 
the emitter. Pulse 20, as before, is the directly transmitted pulse. Pulses 22, 24 and 26 are reflections from 
terrain points in the region around the observation point. A broken horizontal line 28 represents the 
threshold for discriminating between reflected pulses and noise. The time delay between pulses 20 and 22 
is represented as n. The time delay between pulses 20 and 24 is represented as r2. The time delay 
between pulses 20 and 26 Is represented as ra. Delays n, t2, and rs are proportional to the transmission 
paths from the emitter to the observation points via the terrain points of reflection minus the direct 
transmission paths from the emitter to the observation point, i.e., r. 

FIG. 6 illustrates apparatus for collecting and processing the^pulses from the emitter at the observation 
point. The radio frequency energy is intercepted by an antenna 30 and fed to a receiver 32, which converts 
the radio frequency energy to intermediate frequency. A Peak of Beam (POB) detector 34 controls a 
transmission gate 36. With reference to FIG. 4, detector 34 opens gate 36 for the interval between two 
successive POB pulses 18, during which a total of 5,400 directly transmitted pulses pass from receiver 32 
through gate 36 to a transmission gate 38. These pulses are sensed by a direct pulse detector 40 and 
applied to a counter 42. After every 30th pulse, counter 42 opens gate 38 for a sampling interval T. The 
resulting sample as represented in FIG. 5 is coupled to an analog to digital (A/D) converter 44, which 
digitizes a large number of samples, e.g., 3,000 samples at sampling intervals of 0.2 microsecond. The 
digitized samples are collected in a buffer storage device 46. After all the samples have been digitized they 
are transferred en masse to the memory of computer 48. 

The emitter is located by comparing the time delays of the reflected pulses with intervisibility data 
stored in the memory of computer 48. For each terrain point (I, J) in the region around the observation point 
there are stored in the memory of computer 48 a value of masking depth. Z"l.e., the height above the 
terrain point that is visible from the observation point For a description of a method for determining such 
Intervisibility data, co-pending commonly assigned Application Serial No. 89106258.0 , filed on April 8 . 1989 
, by R. E. Huss and R. M. Denlinger (Attorney Docket 2405P171EP). is incorporated fully herein by 
reference. Computer 48 compares terrain points of reflection (I, J) calculated from the measured times of 
arrival of a pulse transmitted by the emitter using equations (3) and (4) for candidate, i.e., assumed emitter 
locations, r. with the stored intervisibility data of terrain points (I, J). From this comparison, emitter locations 
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corresponding to some terrain points (I, J) can be eliminated from consideration for tlie location of the 

emitter, because of the intervisibliity data at such terrain points. For example, the masking depth at a 

particular terrain point might be so high that a reflection from such terrain point to the observation point 

would be virtually impossible. 
5 Alternatively, the masking depth at a particular terrain point might be near zero or the terrain point may 

be visible from the observation point so that a pulse transmitted from an assumed emitter location could 

have been reflected from that terrain point with the time delay, r, of the signal received at the observation 

point; such an assumed emitter location is a good candidate for acceptance as the actual emitter location. 

By utilizing, in addition, other data about the terrain points such as reflectivity, intervisibliity data between 
10 the terrain point and the assumed emitter location, and measured time delay data to other observation 

points, the evaluation of possible emitter locations, vis-a-vis the terrain points in the region around the 

observation point, can be further refined. 

The process is depicted functionally in FIG. 7. Intervisibliity data represented by a block 50, namely I, J, 

and TT, and reflected signal data represented by a block 52, namely D and e are evaluated, as represented 
75 by a block 54. The result of this evaluation provides a feasibility of candidate emitter locations at the terrain 

points in the region about the observation point, as represented by a block 56. As represented by a block 

58. other data can also be evaluated to refine the feasibility indication. 

FIGS. 8A to 8D represent plots of feasibility of various emitter locations. The feasibility (F) is indicated 

on the vertical axis, and the terrain points of candidate emitter locations from the observation point (0) are 
20 indicated on the J and I axes. The feasibility (F) for each terrain point is determined by counting the number 

of reflections received at the observation point that could have been transmitted from each terrain point, 

assuming that it was the emitter location, based on the comparison of time delays of reflected pulses with 

intervisibliity data The highest value of feasibility (F) occurs at the likely emitter location (E). Thus. FIGS. 

8A to 8D depict a scoring function of the possible emitter locations based on the described comparison of 
25 the time delays of the reflected pulses with the intervisibliity data. Different measures of scoring, i.e., 

evaluating these comparisons, could be employed to further refine the feasibility data. 

Reference is made to Appendix A for a program listing of software for evaluating candidate emitter 

locations in the described manner on a Digital Equipment Corporation VAXA/MS, Version V4.6 computer. 
The described embodiment of the invention is only considered to be preferred and illustrative of the 
30 inventive concept; the scope of the invention is not to be restricted to such embodiments. Various and 

numerous other arrangements may be devised by one skilled in the art without departing from the spirit and 

scope of this invention. 

35 Claims 

1. A method for locating a radio frequency emitter (10) that transmits pulses (18. 20) in a swept beam 
pattern, characterized by the steps of: 

- storing intervisibliity data (50) of terrain points (14) in a region around an observation point (12); 

40 - measuring at the observation point (12) the times of arrival (r) of a plurality of terrain point (14) reflections 
(52) of a single pulse (18, 20) transmitted by the emitter (10); 

- repeating the measuring step for a plurality of pulses (18, 20) transmitted by the emitter (10); and 

- comparing terrain points (14) of reflection calculated from the measured times of arrival (t) for assumed 
emitter (10) locations with the stored intervisibliity data (50) of terrain points (14), 

45 2. The method of claim 1, characterized In that the measuring step comprises measuring the times of 
arrival (r) of the plurality of terrain point (14) reflections (52) relative to the time of arrival (t) of the single 
pulse (18, 20) directly from the emitter (10). 

3. The method of claim 1 or 2, characterized in that the repeating step measures a fraction of the 
pulses (18, 20) transmitted by the emitter (10). 

50 4, The method of any of claims 1 through 3, characterized by the steps of storing reflectivity data (52) 
of terrain points (14) in the region and comparing the terrain points (14) of reflection calculated from the 
measured times of arrival (r) for assumed emitter (10) locations with the stored relfectivity data (52) of 
terrain points (14). 

56 



5 



EP 0 342 529 A2 



BB3BBBBBBB 
BBBBBBBBBB 
BBBBBBBBBB 



APPENDIX A 

7777777777777. .777777777777777777777777777777 '777 
millll Interactive System Design Center 11111111 

iiiiiiiiii:niiiiiiiiiiiiiii'i^'i''i~'''''^'^^^^^ 



BBBBBBBBBB 
BBBBBBBBBB 
BBBBBBBBBB 



NOTE: JIM 



000 


RRRR 


ssss 


BBBB 


000 


ssss 


0 0 


R R 


s 


B B 


0 0 


s 


0 0 


R R 


s 


B B 


0 0 


s 


0 0 


RRRR 


sss 


BBBB 


0 0 


sss 


0 0 


R R 


s 


B B 


0 0 


s 


0 0 


R R 


s 


B B 


0 0 


s 


000 


R - R 


ssss 


BBBB 


000 


ssss 



pppp 


EEEEE 


L 


1 


N N 


\s L' L' P P 
f / Pi i:» r« 


W W 


p p 


E 


L 


11 


N N 


E 


w w 


p p 


E 


L 


1 


NN N 


E 


w w 


pppp 


EEEE 


L 


1 


N N N 


EEEE 


w w 


p 


E 


L 


1 


N NN 


E 


www 


p 


E 


L 


1 


N N 


E 


WW WW 


p 




LLLLL 


111 


N N 


EEEEE 


W w 




FPFFF 


000 


RRRR 


5 \ 


333 


4 4' 




F 


0 0 


R R 


\ \ 


3 3 


4 4 




F 


0 0 


R R 




3 


4 4 




FFFF 


0 0 


RRRR 


5 > 


3 


44444 




P 


0 0 


R R 


\ \ 


3 


4 




F 


0 0 


R R 




3 3 


4 




F 


000 


R R 


\ 


333 


4 



File $9SDRB5: r0RSB0S.PEL3PELlNEW.F0R;34 (800,345,0), last revised on 
3O-N0V-1987 09:26, is a 43 block sequential file owned by UIG [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 75 bytes. 

Job PELINEW (187) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 3O-N0V-1987 09:35 from queue SP0CK_LAS2. 

BBBBBBBBBB 7777777777777777777777777777777777777777777777777777 BBBBBBBBBB 
BBBBBBBBBB Digital Equipment Corporation - VAX/VMS Version V4.6 BBBBBBBBBB 
BBBBBBBBBB 7777777777777777777777777777777777777777777777777777 BBBBBBBBBB 

(c) Hughes 1987 
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PROGRAM PELINEW 



C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



Program PELINEW - Created 5/6/87 from PELl 

Revised 6/1/87, 6/4/87, 6/9/87, 7/6/87 

Input Files: 

* Terminal 

Output Files: » 

* Terminal 

* PELINEW. OUT (Unit = 2) 



C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



Subroutines Used: 

* FETCHVIS 

* DISPVIS 

»,SECT 

* DISPSECT 

* GETTAU 

* GENSUM200 - 

* DISCSET 

* SCOREF 

* SORT 

* GORE 
♦.COUNTSC 

* LINHIST 

* HISTOCl 

* HIST0C2 



This subroutine reads the two visibility maps. 

This subroutine will, if desired, display the 

visibility map on the Ramtek. 

Determines the boundaries of the "processing 

sector" to be used. (A square) 

Prints a map showing the "processing sector." 

Does not change any external values. 

Gets the returned signal. 

Processes the returned signal. 

Generates the "discriminant function" over the 

map . 

Calculates the "score" for the Sector. 
Effectively, sorts the sector points into 
order according to discriminant value. 
Creates table with MD^^PQWER in descending 
rank order. 

Only writes to Unit 2, does not change any 
values . 

Does not change any external values. 
Does not change any external values. 
Does not change any external values. 



C***** ****************************************************** ********** 



C 
C 
C 

c 

c 
c 

0 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
*c 



LOGICAL * 
LOGICAL * 
CHARACTER 
CHARACTER 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
INTEGER * 
REAL * 4 
REAL * 4 
REAL * 4 



PFLAG, SDFLAG, HFLAG, RFLAG, BFLAG, CFLAG 

SECFLG 

CMD * 1, RDATE * 9, RTIME * 8 

DIR * 19, TEST_ID * 6 

VISA (0:1118, 0:934) 

INDEX (10000), MAXVAL (10000) 

COORDI (10000), COORDJ (10000), RANK (10000) 

MAPCNT (10000) 

ILIM (-1:1), JLIM (2, 935) 

CRITMDl, CRITMD2 

ITER, KCHAR (4), NCOUNT, MAXK, MMAXK, IRES 
II, K_E, NTAU, MAXTAU, MAXSEC 
IDN, lUP, JDN, JUP, MAXROW, MAXRXC 
lEMROTFLAG, ISCANSTART, ISCANEND 
THRESH, KSTART 

POWER, DELTA_TAU, RMIN, DISTANCE_FROM_E (10000) 
PHIO, THETA, RAE, MINDISC, MAXDISC 
DISTANCE FROM_B (10000) , SUMS (10000) 
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REAL * 4 a. JM (10000), DISC (10000), DISS 0000) 

REAL » 4 . SCORE 

REAL * 4 .EATAU (3000), RCRIT, ALPHAR, ALPHAL 

REAL * 4 THETAD, GRAD 

INTEGER - 2 BUFFER (-1:3000, 180) ! BUFFER FOR FILE READ 

INTEGER » 2 mJM RECORDS ! # OF BEAM POSITIONS COLLECTED 



DATA MAXTAU /1370/, MAXSEC /lOOOO/ 

DATA GRAD /57. 29577951/ 

DATA MAXROW, MAXRXC /935, 1046265/ 

***** COMMON blocks: 

CHARACTER BLANKL * 106, TITLE * 106 

INTEGER * 4 JMINP, JMAXP, IMINP, IMAXP, JLEN, ILEN 

" COMMON /HIST/ BLANKL, TITLE, JMINP, JMAXP, IMINP, IMAXP, JLEN, 
1 ILEN 

INTEGER * 4 IO_A, JO_A, IO_A_M, J0_A_M, I0_B, J0_B, I0_B_M 

INTEGER * 4 JO_B_M, lOJE, JO_E, IO_E_M, JO_E_M 

COMMON /POSITS/ 10 A, JO_A, IO_A_M, JO_A_M, IO_B, JO_B, IO_B_M, 
1 JO_B_M, IO_E, JO_E, IO_E_M, JO_E_M 

INCLUDE 'BUFF.CMN' 
***** Initializations (COMMON block values) : 

DO II = 1, 106 

BLANKL (II: II) = ' ' 
END DO 



******;**** 



**********************************************************C 



CALL TIME (RTIME) 
CALL DATE (RDATE) 

1*********************************************************************0 

c 

Read parameters from operator; Print to output file: C 

* TITLE - Header line for output file(s). C 

* VQWS. - An exponent (power) for masking depth penalty. C 

* RFLAG - Indicates if ranking is to be used. C 

* CRITflDl - "Splash points" with masking depths less than C 

(or equal to) this value are treated as C 
"visible", i.e., with masking depth of zero. C 

* GRITMD2 - "Splash points" with masking depths greater than C 

this value are not processed, i.e., they are C 
treated as absolutely not visible. C 

* RMIN - Minimum range; any point whose range from A is C 

less than "rmin" km is given 0 hits. C 

* DELTA_TAU - Minimum delta tau. C 

* RCRIT - "Critical Radius." Radius of a circle around the C 

true emitter location within which the "score" C 
does not depend on range. C 

* ALPHAR - Exponent that determines the strength of range C 

dependence of the score, outside of the minimum C 
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-C rang C 

C * ALPHAL - Scale factor that operates on the Discriminant C 

C ' values in calculating the Score. C 

,C * IDN, lUP - Limits of the row values in the maps to be read. C 

C These correspond to the X coordinate. C 

C * JDN, JUP - Limits of the column values in the maps to be C 

C read. These correspond to the Y coordinate, C 

C * lEMROTFLAG - Flag for emitter rotation. C 

C ( 1 = clockwise, 2 = counterclockwise) C 

C * ISCANSTART - Starting scan number, C 

C * ISCANEND - Last scan number, C 

C * THRESH - Threshold for signal strength. C 

C * KSTART - Time delay sample starting number, C 

C * * TEST_ID - Clutter file name. C 

C * DIE - Clutter file directory. C 

C C 



C , 

WRITE (*, 1050) 

1050 FORMAT ('0', 'Enter header line for output on next line:') 
^ READ (*, 1015) TITLE 

Ol5 FORMAT (A80) 
C 

WRITE (*, 1055) 

1055 FORMAT (' '/'S', 'Enter Lower masking depth cutoff value: ') 
ACCEPT *, CRITMDl 

C 

WRITE (*, 1170) 

1170 FORMAT (' '/'$', 'Enter Higher masking depth cutoff value: ') 
ACCEPT *, CRITMD2 

C 

WRITE (*, 1035) 

1035 FORMAT (' '/'$', 'Enter Power (exponent) of masking depth: ') 
ACCEPT *, POWER 

C 

WRITE (*, 1060) 
1060 FORMAT (' '/'$', 'Enter minimum range (in Km) : ') 
ACCEPT *, RMIN 

C 

WRITE (*, 1065; 

^^65 FORMAT (' '/'$', 'Enter minimum delta tau (in microseconds): ') 
ACCEPT *, DELTA_TAU 

C 

WRITE (*,1125) 
1125 FORMAT (' '/'S', 

1 'Enter the critical range for scoring (meters): ') 
ACCEPT *, RCRIT 

C 

WRITE (*, 1130) 

1130 FORMAT (' '/'S', 'Enter the range exponent for scoring: ') 
ACCEPT *, ALPHAR 

C 

WRITE (*, 1140) 

1140 FORMAT (' '/'$', 'Enter the level scale factor for scoring: ') 
ACCEPT *, ALPHAL 

C 

WRITE (*, 1155) 

1155 FORMAT (' '/'S', 'Enter map row limits (IDN.IUP) : ') 
ACCEPT *, IDN, lUP 

C 

WRITE (*,1160) 



EP 0 342 529 A2 

1160 FORMAT (' '/'S'.'Er. : map column limits (JDN, JUP) : 
ACCEPT *, JDN, JUP 

C 

IF ((lUP - IDN * 1) .GT. MAXROW) THEN 
WITE (*, 1157) 
GO TO 9999 
» END IF 

1157 FORMAT ('0','***» Too many Rows ) 
C 

IF ((lUP - IDN + 1) * (JUP - JDN + 1) .GT. MAXRXC) THEN 

WRITE (*,1162) 

60 TO 9999 
END IF 

1162 - FORMAT ('0','**** Too many Rows times Coltimns.') 

C 

C ****** Print parameters to output file (PELINEW.OUT) : 
C 

OPEN (UNIT = 2, FILE = 'PELINEW.OUT', STATUS = 'NEW') 

C 

WRITE (2, 1020) TITLE 

;l^020 format ('O', ASO) 

WRITE (2, 1105) RDATE, RTIME 
1105 FORMAT ('0'/' ' ,8X, 'Program PELINEW - Run on ',A9,' at ',A8) 
C 

WRITE (2, 1030) CRITMDl 
1030 FORMAT ('0'/' ' , ' (M) Lower cutoff value of masking depth = ',16) 
C 

WRITE (2, 1175) GRITMD2 
1175 FORMAT ('0','(M) Upper cutoff value of masking depth = ',16) 
C 

WRITE (2, 1025) POWER 
1025 FORMAT ('0','(M) Power (exponent) of masking depth = ',F4.1) 
C 

WRITE (2, 1051) RMIN 
1051 FORMAT ('0','(M) Any point whose range from A is less than ', 
1 ■ F4.1, ' km is given 0 hits') 

C . 

WRITE (2, 1040) DELTA_TAU 
1040 FORMAT i'0','Qi) Minimum delta tau = ',F4.2,' microseconds') 

WRITE- (2, 1135) RCRIT, ALPHAR 
1135 FORMAT ('0','(M) Range dependence for scoring starts at ',F8.3, 

1 ' meters ' , 

2 /'0','(M) Exponent for range dependence of score = ',F6.3) 

C 

WRITE (2, 1145) ALPHAL 
1145 FORMAT- ('0' ,' (M) Scale factor for level dependence of score = ', 
1 F6.3) 

C 

WRITE (2, 1165) IDN, lUP, JDN, JUP 
1165 FORMAT ('0','(M) Map rows are from ',14,' to ',14, 

1 /'0','(M) Map columns are from ',14,' to ',14) 

C 

C C 
C Get printing option requests C 

C C 

C 4c * a|c 3|e ale :k :tc **** :4: * 4: ******** 4: :f: :ic :t: ^ 

C 

110 WRITE (*, 1045) 
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■1045 FORMAT (' '/'S'.'Do ju want ranking? (Y or N) ') 
READ (*, 1005) CMD 

IF (CMD .EQ. 'Y' .OR. CMD .EQ. 'y') THEN 
RFLAG=.TRUE. 
ELSE IF (CMD .EQ. 'N' .OR. CMD .EQ. 'n') THEN 

RFLAG=. FALSE. 
ELSE 

WRITE (*,1010) 
GO TO 110 
END IF . 

C 

IF (.NOT. RFLAG) THEN 

SDFLAG = .FALSE. 

GO TO 193 
END IF 

192 WITE (*, 1092) 

1092 FORMAT (' '/'^'j'Do you want a sector point-by-point detail? ') 
READ (*,1005) CMD 

IF (CMD .EQ. 'Y' .OR. CMD .EQ. 'y') THEN 
SDFLAG=.TRUB. 
ELSE IF (CMD.EQ. 'N' .OR.CMD.EQ. 'n') THEN 
(V SDFLAG=. FALSE. 

, ELSE 

WRITE (*,1010) 
GO TO 192 

END IF 

193 CONTINUE 
C 

194 WRITE (*, 1094) 

1094 FORMAT (' 'Do you -want values printed out (table)? ') 
READ (*, 1005) CMD 

IF (CMD .EQ. 'Y' .OR. CMD .EQ. 'y') THEN 
CFLAG=.TRUE. 
ELSE IF (CMD.EQ. 'N'. OR. CMD. EQ. 'n') THEN 
CFLAG=. FALSE. 
. ELSE 

WRITE (*,1010) 
GO TO 194 
END IF 

•^95 WRITE (*,1095) 

1095 FORMAT (' '/'$'. 'Do you want a linear histogram printed? ') 
READ (*, 1005) CMD 

IF (CMD .EQ. 'Y' .OR. CMD .EQ. 'y') THEN 

BFLAG=.TRUE. 
ELSE IF (CMD .EQ. 'N' .OR. CMD .EQ. 'n') THEN 

BFLAG=. FALSE. 
ELSE 

WRITE (*,1010) 

GO TO 195 

END IF 

C 

196 WRITE (*, 1096) 

1096 FORMAT (' ^ f^%\^Y>o you want low sensitivity histograms also? ') 
READ (*, 1005) CMD 

IF (CMD .EQ. 'Y' .OR. CMD .EQ. 'y') THEN 

flFLAG=.TRUE. 
ELSE IF (CMD .EQ. 'N' .OR. CMD .EQ. 'n') THEN 

HFLAG=. FALSE. 
ELSE 

WRITE (*,1010) 
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GO TO 196 

END IF 

C 

-197 TOITE («,1180) 
' 1180 FORMAT (' '/'S','Do you want Full (F) or Restricted area (R) ', 
1 'maps? ') 

READ (*, 1005) CMD 

IF (CMD .EQ. 'F' .OR. CMD .EQ. 'f') THEN 

SECFLG=.TRUE. 
ELSE IF (CMD .EQ. 'R' .OR. CMD .EQ. 'r') THEN 

SECFLG=. FALSE. 
ELSE 

WRITE (*,1010) ' 

GO TO 197 

END IF 

C 

c****************************************************** ********** 

c . c 

C Get emitter and scan information, threshold for signal C 

C strength and starting sample number for time delay C 

A ^ 

i; i* ************************************************************ ******* 

C : 

198 TYPE '(A, $)', ' Enter 1 if emitter is rotating clockwise, 
1 -1 if rotating counterclockwise >» ' 
ACCEPT *, lEMROTFLAG 

IF (lEMROTFLAG .NE. 1 .AND. lEMROTFLAG .NE. -1) THEN 
TYPE *, ' BAD VALUE FOR FLAG, EE-ENTER' 
GO TO 198 

END IF 

C 

WRITE (2, 1185) lEMROTFLAG 
1185 FORMAT ('0','(M) Emitter rotation flag is ',14, 

1 ' (1 = clockwise, -1 = counterclockwise)') 



C 
C 

C 



TYPE '(A, $)', ' Enter first and last scan numbers (1-180) »> ' 
ACCEPT *, ISCANSTART, ISCANEND 

WRITE (2, 1205) ISCANSTART, ISCANEND 
:205 FORMAT ('0','(M) Starting scan number: ',14, 
1 /'0','(M) Ending scan number: ',14) 



TYPE ' (A, $) ' , ' Enter the signal strength threshold (1-255) »> ' 
ACCEPT *, THRESH 
WRITE (2, 1206) THRESH 
1206 FORMAT ('0','(M) Signal strength threshold: ',14) 



C 



TYPE ' (A, $) ' , ' Enter time delay starting sample number (1-3000) »> ' 
ACCEPT *, KSTART 
WRITE (2, 1207) KSTART 
1207 FORMAT ('0','(M) Time delay starting sample number: ',14) 
C 

c********************************** ********************** 

C C 

C Get clutter file name and directory. C 

c c 
c************************************ ****************************** ****c 
c 

TYPE ' (A, S) ' , ' ENTER THE CLUTTER FILE NAME »> ' 
ACCEPT 1208, TEST_ID 
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•1208 FORMAT (A6) 

WRITE (2, 1209) TEST_ID 

1209 FORMAT ('0','(M) Clutter file name: \a6, ' .GLUT') 

TYPE '(A, S)', ' ENTER THE CLUTTER FILE DIRECTORY »> ' 
ACCEPT 1210, DIR 

1210 FORMAT (A19) 
WRITE (2, 1211) DIR 

1211 FORMAT ('0','(M) Clutter file directory: ',al9) 
0 

C************************* ***************************** ******* 

C Initial calculations: C 

C c 

C*****4************************************ ******************** 
C 

C ****** Read visibility maps; optionally display: 
C 

CALL FETCHVIS (VISA, IDN, lUP, JDN, JUP) 

C 

CALL DISPVIS (VISA, IDN, lUP, JDN, JUP) 

1^ •)****«* Set up "low resolution processing sector" map; display: 
C < 

CALL SECT (RMIN, 10 B, JO_B, DISTANCE_FROM_E, KCHAR, MAXVAL, 

1 COORDI, COORD J, CUMSUM, IRES, MAPCNT, MAXK, 

2 DISTANCE_FROM_B, MMAXK, NCOUNT, K_E, MAXSEC, ILIM, 

3 JLIM, IDN, lUP, JDN, JUP, SECFLG, ERROR) 

C 

CALL DISPSECT (IRES, MAPCNT, IDN, lUP, ILIM, JLIM) 
C***********************************************************************' 

C "Case Loop" ^ 

C ^ 
C Each iteration of this loop corresponds to a new scan number C 

C \rfiich in turn corresponds to a new value of theta. C 

C********* ************************ ********************.*****************^ 

c 

****** Initialize Iteration count (# of SCANS processed): 
ITER = 1 

C 

C ****** DO LOOP stepping through scan numbers: 
C 

DO I = ISCANSTART, ISCANEND 

C 

IF (ITER .EQ. 1 .OR. ITER .EO. 2 .OR. ITER .EQ. 4 .OR. 

1 ITER .EQ. 8 .OR. ITER .EQ. 16 .OR. ITER .EQ. 32 .OR. 

2 ITER .EQ. 64 .OR. ITER .EQ. 128 .OR. ITER .EQ. ISCANEND) THEN 

PFLAG = .TRUE. 
ELSE 

PFLAG = .FALSE. 

END IF 

C ****** Write out scan number being processed 
C 

WRITE (*, 1100) ITER 
1100 FORMAT (' 7'$', 'Processing scan # ',13,': ') 
C 

C ****** Get TIME DELAY array: 
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CALL GETTAU (DELTA TAU, I, lEMROTFLAG, THRESH, KSTART, 
1 THETAD, MAXTAU, EATAU, XTAU) 

C 

C ****** Get theta value in radians. Angle was calculated in GETTAU 

Q ****** to correspond to scan number. 

C 

THETA = THETAD / GRAD 

C . , 

C ****** Process returned signal: 

^ IF (NTAU .GT. 0) CALL GENSUM200 (NTAU, EATAU, IO_A, JO_A, 

1 '•- DISTANCE_FROM_B, POWER, 

2' CRITMDl, CRITMD2, THETA, VISA, 

3 MAXVAL, CUMSUM, SUMS, IRES, 

4 MAPCNT, ILIM, JLIM, IDN, lUP, 

5 JDN, JUP) 

C ■ 

C ****** Print if this is one of the selected Scan values: 
C 

IF (.NOT. PFLAG) GO TO 600 

C ****** ! Calculate discriminant function at sector points: 
C 

CALL DISCSET (MAXK, SUMS, CUMSUM, MAPCNT, DISC, MINDISC, 
1 MAJCDISC, DISS) 

C 

C ****** Calculate the "score": 
C 

CALL SCOREF (DISC, MINDISC, MAXDISC, MAPCNT, MAXK, MMAXK, K_E, 
1 DISTANCE_FROM_B, RCRIT, ALPHAR, ALPHAL, SCORE) 

IF (RFLAG) CALL SORT (INDEX, NCOUNT, RANK, MAXK, MMAXK, DISC, 
1 MAPCNT) 

IF (CFLAG) CALL COUNTSC (ITER, RANK, DISC, IRES, MAPCNT, RFLAG, 
1 IDN, lUP, ILIM, JLIM) 

IF (BFLAG) CALL LINHIST (ITER, TITLE, MAXK, K_E, MINDISC, 
1 - MAXDISC, DISC, MAPCNT) 

IF (SDFLAG) CALL GORP (MAXK, NCOUNT, MMAXK, INDEX, DISC, MAPCNT, 
1 COORDI, COORD J, KCHAR, MAXVAL, 

2- DISTANCE_FROM_E, IRES, POY/ER, TITLE, K_E, 

3 0) 

C 

IF (HFLAG) CALL HISTOCl (ITER, MINT)ISC, MAXDISC, DISC, IRES, 

1 • MAPCNT, SCORE, K_E, IDN, lUP, ILIM, 

2 JLIM) 

^ CALL HIST0C2 (ITER, RANK, MMAXK, MINDISC, MAXDISC, DISC, IRES, 

1 MAPCNT, RFLAG, SCORE, K_E, IDN, lUP, ILIM, JLIM) 

C 

C WRITE OUT ESTIMATION OF EMITTER LOCATION AND ERROR 

C FROM ACTUAL EMITTER LOCATION. 

C 

KK = INDEX (MMAXK + NCOUNT) 

C 

PEL_J = FLOAT (COORDJ (KK)) 

C 

10 = COORDI (KK) 



C 
C 
C 
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PEL_I = FLOAT (10) 



WRITE (2, 6100) PEL_I, PEL_J 
6100 FORMAT (//,1X, 30H PREDICTED EMITTER LOCATION , 
1 2F15.6) J 

^ CIMISS = SQRT ( (FLOAT (IO_E) - PEL_I) ** 2 * 

1 (FLOAT (JO_E) - PEL_J) **2 ) 

WRITE (2, 6200) CIMISS 
6200 FORMAT (IX, 30H ERROR IN ESTIMATE 

1 F15.6) 

C 

C ****** Finished with this SCAN; Get another. 
C 

600 CONTINUE 

ITER = ITER + 1 

C 

END DO 

S*********************************************************************^ 



C End of "case loop." ^ 

C 

C**********************************************************************^ 

c 

1005 FORMAT (Al) . 
1010 FORMAT ('0','**** Incorrect entry, try again. J 

C 

C ****** PROGRAM TERMINATION: 
0 

aOSE (UNIT = 2) 

C 

9999 WRITE (*, 1110) , , 

1110 FORMAT ('0',' PELINEW bids you adieu',/ ) 

C 

STOP 
END 
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File _$9$DRB5:[0RSB0S.PEL]C0UNTSC.F0R;26 (322,225,0), last revised on 
30-NOV-1987 09:26, is a 16 block sequential file owned by UIC [ORSBOS] . The 
records are variable length v?ith implied (CR) carriage control . The longest 
record is 72 bytes. 

Job COUNTSC (174) queued to SP0CK_LAS2 on 30-NOV-1987 09:26 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$m4: 
on 3O-N0V-1987 09:26 from queue SP0CK_LAS2. 

0000000000 4444444444444444444444444444444444444444444444444444 0000000000 
0000000000 DigifarEquipmen-t-C-orporation--^VAX/VMS Version V4-r6 0000000000 
0000000000 4444444444444444444444444444444444444444444444444444 0000000000 
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SUBROUTINE COUNTSC (I. RANK, DISC, IRES, MAPCNT,RFLAG, I ,IUP, 
ILIM,JLIM) 

C*«**»*» »»«•»* «»»**«»***********"'************'**************************^ 



c 



c 



c 



c 



c 



c 
c- 
c 

a 

* 



c 



C Subroutine COUNTSC - Revision 3/7/86 C 



C 

0 This subroutine prints out the count values which correspond C 

C to the histogram points, generated by subroutines HISTOGRAMCl, C 
0 etc. The values printed are somewhat coded, as follows: C 



C 



C For RFLAG = .FALSE. : C 

C * '*' - Indicates that the point is not in the "processing C 

C ' - sector." C 

C * 'Rmin' - Indicates that the point is inside the "minimum C 

C range" from the aircraft. (MAPCNT=-1) C 

C * 'No H' - Indicates that the point got no "hits." (MAPCNT=0) C 

C - * »> - Indicates that the value computed was too large to C 

C print (greater than 99999.5) . C 

C * «< - Indicates that the value computed was too large a C 

^(SL negative value to print (less than -9999.5). C 

i-J * A numerical value is just the value of DISC. C 



C 



C For RFLAG = .TRUE.: " C 



C 



C * '*» - Indicates that point is not in the "processing C 

C sector . " ^ C 

C * 'Rmin' - Indicates that the point is inside the "minimum C 

C range" from the aircraft. (MAPCNT=-1) C 

C * 'No H' - Indicates that the point got no "hits." (MAPCNT=0) C 

C ■ * »> - Indicates that the value computed was too large to C 

C print (greater than 99999) . C 

C * A numerical value is just the value of RANK. C 



C 



C Note: No external values (COMMON or parameters) are changed C 

C by this subroutine; only printing is done. C 



c 

c 

c 

Input Files: None. C 

C 

C Output Files: C 
C c 

C * Unit 2 - Not opened, from caller. C 



C 



C 



C Routines Used: None. C 



C 



(3******************************************************** 
LOGICAL RFLAG 
CHARACTER*5 CLINE(106) 

INTEGER*2 RANK(IOOOO) ,PVALS(106) ,PFLGS(106) ,MAPCNT( 10000) , 
+ ILIM(-1:1),JLIM(2,IDN:IUP) 
INTEGER*4 ITER , IRES , IO_R , JO_R , KK, LL , ILEN , IDN , lUP 
REAL*4 DISC (10000), TEMP 

C 

C COMMON blocks: 

C • ~ 

CHARACTER BLANKL*106,TITLE*106 
INTEGER*4 JMINP , JMAXP , IMINP , IMAXP , JLEN 
COMMON /HIST/ BLANKL,TITLE, JMINP, JMAXP, IMINP, IMAXP, JLEN 

C* ***************************************************** ***************^^ 
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C 

C Page headers: 

C 

raiTE (2,1005) TITLE 

1005 FORMAT ('1'/' ' ,A80) 

C 

ILEN = 1 - ( ITER .ge. 10 ) 
IF (RFLAG) THEN 

IF (ITER.eq.l) THEN 

WRITE (2,1006) ITER 
ELSE 

WRITE (2,1007) ITER 
END IF 

ELSE 

WRITE (2,1110) ITER 
END IF 

1006 FORMAT ('O'/'O' , 'Ranking after ',11,' scan:',/) 

1007 FORMAT ('O'/'O' , 'Ranking after ',I<ILEN>,' scans:',/) 
1110 FORMAT ('O'/'O', 'Cumulative discriminant after ',I<ILEN>, 

+ ' scans : ' , /) 

C ****** .Print Histogram like map; first, the column header: 
C 

WRITE (2,1035) (LL,LL=JMINP, JMAXP,IRES) 
C 1035 FORMAT ('0'/' ' ,6X,14(X,I4) ,7(/' ' ,6X,14(X,I4))) 
1035 FORMAT ('0'/' ' ,6X, <JLEN>(X,I4) ,7(/' ' ,6X,<JLEN>(X,I4))) 

C 

C ****** Part of map "above" processing sector: 
C 

DO 201 LL = 1,JLEN 
CLINE(LL) = ' * ' 
201 CONTINUE 

C 

DO 205 10 R = IMIN?,ILIM(-1)-1,IRES 
WRITE (2,T030) I0_R, (CLINE(LL) ,LL=1, JLEN) 
205 CONTINUE 

C 

C ****** Part of map including processing sector: 

C. 

: KK = 0 

DO 210 IO_R = ILIM(-l) , ILIM(l) , IRES 

C 

DO 200 LL = 1,106 
PFLGS(LL) = -2 
200 CONTINUE 

C 

DO 100 J0_R = JLIM(1,I0_R), JLIM(2,I0_R) , IRES 
KK = KK + 1 

LL=1+ (JO_R-JMINP) /IRES 

C 

IF (RFLAG) THEN 

IF (MAPCNT(KK) .LT.O) THEN 

PFLGS(LL)=-1 
ELSE IF (MAPCNT(KK).EQ.O) THEN 

PFLGS(LL)=-3 - 

ELSE 

TEMP = RANK(KK) 

IF (TEMP. GT. 99999. 5) THEN 

PFLGS(LL)=-5 
ELSE 
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PVALS(LL)=TEMP 
PFLGS(LL)=0 
GO TO 100 
END IF 

END IF 
ELSE 

IF (MAPCNT(KK).LT.O) THEN 

PFLGS(LL)=-1 
ELSE IF (MAPCNT(KK) .EQ.O) THEN 

PFLGS(LL)=-3 

ELSE 

TEMP = DISC(KK) 

IF (TEMP. GT. 99999. 5) THEN 

PFLGS(LL)=-5 
ELSE IF (TEMP. LT. -9999. 5) THEN 

PFLGS(LL) 

ELSE 

PVALS(LL)=NINT(TEMP) 
PFLGS(LL)=0 
END IF 
END IF 
( J END IF 

100 CONTINUE 

C 

C ****** Construct output line: 
C 

DO 120 LL = 1,JLEN 

IF (PFLGS(LL) .EQ.O) THEN 

WRITE (CLINE(LL),1020) PVALS(LL) 
ELSE IF (PFLGS(LL).EQ.-2) THEN 

CLINE(LL) = ' * ' 
ELSE IF (PFLGS(LL) .EQ.-5) THEN 

CLINE(LL) = ' »> ' 
ELSE IF (PFLGS(LL) .EQ.-6) THEN 

CLINE(LL) = ' «< ' 
ELSE IF (PFLGS(LL) .EQ.-3) THEN 

CLINE(LL) = ' No fl' 
ELSE IF (PFLGS(LL).EQ.-l) THEN 

aiNE(LL) = ' Rmin' 
END IF 
•w'l20 CONTINUE 
1020 FORMAT (15) 

C 

Q ****** Print output line: 
C 

WRITE (2,1030) IO_R, (CLINE(LL) , LL = 1,JLEN) 
C 1030 FORMAT (' ' ,I3,3X,14A5,7(/' ',6X,14A5)) 
1030 FORMAT (' ' ,I3,3X,<JLEN>A5,7(/' ' ,6X, <JLEN>A5)) 
210 CONTINUE 

C 

C ****** Part of map "below" processing sector: 
C 

DO 202 LL = 1,JLEN 
CLINE(LL) = ' * ' 
202 CONTINTJE 

C 

DO 220 10 R ^-ItIM(l)+l,-lMAXP,IRES 

WRITE (2,T030) IO_R, (CLINE(LL) ,LL=1,JLEN) 
220 CONTINUE 

C 

C ****** RETURN TO CALLER: 



RETURN 
END 
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File $9$DRB5: [0RSB0S.PEL]DISCSET.F0R;3 (328,255,0), last revised on 
30-NOV-1987 09:26, is a 5 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 72 bytes. 

Job DISCSET (175) queued to SP0CK_LAS2 on 30-NOV-1987 09:26 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 3O-N0V-1987 09:27 from queue SP0CK_LAS2. 

PPPPPPPPPP 5555555555555555555555555555555555555555555555555555 PPPPPPPPPP 
PPPPPPPPPP Digital Equipment Corporation - VAX/VMS Version V4.6 PPPPPPPPPP 
PPPPPPPPPP 5555555555555555555555555555555555555555555555555555 PPPPPPPPPP 
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SUBROUTINE DISCSET (k .JC, SUMS, CUMSUM,MAPCNT, DISC, MINDx .,MAXDISC, 
DISS) 



•c C 

C Subroutine DISCSET - Revision 2/18/86 C 

C C 

c c 

C Input Files: None, C 

c • c 

C Output Files: None. C 

C C 

C Routines Used: None. C 

C C 



C****************************************************************** 
INTEGER*2 MAPCNT (10000) 
INTEGER*4 MAXK,KK 

REAL*4 CUMSUM(IOOOO) , DISC (10000) ,MINDISC,MAXDISC, DISS (10000) , 
- + SUMS (10000) ,MAXR 

C 

DATA MAXR/1.7E38/ 

0>^*** ******************** *******^* ****************** 

V .4*********************************************************************0 

C ' 

C »:**=*** Compute the discriminant fumction, and record min and max 

C ****** values: 

C 

MAXDISC=-MAXR 
MINDISC=0.0 

C 

DO 100 KK=1,MAXK 

IF (MAPCNT(KK) .LE.O) THEN 

DISS(KK)=-MAXR 

C 

DISC(KK)=-Mm 
ELSE 

DISS (KK) =SUMS (KK) /FLOAT (MAPCNT (KK) ) 

C 

DISC (KK) =CUMSUM (KK) /FLOAT (MAPCNT (KK) ) 
MAXDISO=MAX (MAXDISO , DISC (KK) ) 
MINDISC=MIN (MINDISC , DISC (KK) ) 
END IF 

100 CONTINUE 

C 

C ****** Assuming that all (valid) DISC values are negative (and thus 

C ****** non-zero), calculate a logarithimic discriminant: 

C 

DO 200 KK=1,MAXK 

IF (MAPCNT (KK) .GT.O) THEN 

DISC (KK) =-ALOG10 (1 . 0-DISC (KK) ) 
END IF 

200 CONTINUE 

C 

MINDISC=-ALOG10 (1 . 0-MINDISC) 
MAXDISC=-ALOG10 (1 . 0-MAXDISC) 

C 

Q ****** Return to caller: 
C 

RETURN 
END 
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File S9$DRB5: [0RSB0S.PEL]DISPSECT.F0R;6 (635,331,0), last revised on 
30-NOV-1987 09:26, is a 13 block sequential file owned by UIC [flRSBOS] . The 
records are variable length ^with implied (CR) carriage control. The longest 
record is 73 bytes. 

Job DISPSECT (176) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, 
UIC [ORSBOS], under account A6168 at priority 100, started on printer 
_SP0CK$TXA4: on 30-NOV-1987 09:27 from queue SP0CKLAS2. 

QQQQQQQQQQ 6666666666666666666666666666666666666666666666666666 QQQQQQQQQQ 
OQQOQQQQQQ Digits3rEquipment-eDrporation-^=^VAX/VMS Version Y4-r6 QQQQQQQQQQ' 
QQQQQQQQQQ 6666666666666666666656666666666666666666666666666666 QQQQQQQQQQ 
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« 

SUBROUTINE dispsect ( .S,MAPCKT,IDNMUP,ILB1, JLIM) 

c ° 
C Subroutine SECTDISP - Revision 3/7/86 C 

C X 

C This subroutine displays, in the same form as the histogram C 

C subroutines, a "low resolution" map showing the "processing C 

C sector" and the aircraft and emitter positions. C 

^ G 
C Input Files: None. ^ 

C r 
C Output Files: None. ^ 

C ' * Unit 2 - Not opened, from caller. ^ 

C r 
C Routines Used: None. ^ 

C - 

C********************* ************************************************ 
CHARACTER OLINE*106 , HLINE (106) *1 , SYMBOL*! 
INTEGER*2 MAPCNT(IOOOO) ,ILIM(-1:1) , JLIM(2,IDN:IUP) . 
INTEGER*4 IO_R , JO_R , KK ,LL , IRES , JJ , ILEN , IDN , lUP 

DATA HLINE/106*' + V 

C 

C ****** COMMON blocks: 
C 

CHARACTER BLANKL* 106, TITLE* 106 
INTEGER*4 JMINP, JMAXP,IMINP,IMAXP, JLEN 

COMMON /HIST/ BLANKL, TITLE, JMINP,JMAXP,IMINP,IMAXP,JLEN . 

c 

INTEGER*4 IO__,A, J0>, IO>_M, JO^A^M, lO^B , JO_B , IO_^B_M, JO_B_M, 
+ 10 E,JO E,IO E M,JO_E_^M „ ^ „ 

COMMONS/POSITS/ IO__A , JO Jl , lO^A^M , JO_A_^M , IO_^B , JO^B , IO_^B_M , JO_B_M , 
+ IO_E,JO_E,IO_E_M,JO_E_M 
C******************************************************* 

c 

WRITE (2,1005) TITLE 
1005 FORMATC'lV '.A80) 

r» 

Print legend of symbols: 

C 

WRITE (2,1010) 

C 1010 FORMAT ('0V'0',4X,'- indicates a non-sector point; , 

(J + /» ',4X,'* indicates a sector point, outside of the 

Q + ' minimum range ; ' , 

Q + /' ',4X,'o indicates a sector point, inside the 

Q + 'minimum range.', 

C + /'0',4X,'A indicates the aircraft, within the sector;', 

Q + /» ',4X,'a indicates the aircraft, outside the sector;' 

C + /' ',4X,'E indicates the emitter, within the sector;', 

Q + /' ',4X,'e indicates the emitter, outside the sector;', 

Q + /» ',4X,'B or b, if present, indicates the "assumed" ', 

C + 'aircraft position,') 
1010 FORMAT ('0'/'0',4X,'. indicates a non-sector point;', 

+ /' ',4X,'* indicates a sector point, outside -of the ', 

+ /' ',4X,'o indicates a sector point, inside the ', 
+ ' minimum range . ' , 

+ /'0',4X, 'E indicates the emitter, within the sector;', 

+ /' ',4X,'e indicates the emitter, outside the sector..') 
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C 

C ****** Print Histogram: 
C 

TOITE (2,1035) JMINP,JMXP,IRES 
1035 FORMAT ('0'/' ',8X, 'J limits are from ',14,' to ',14,' by ',14, 
+ '.'/'O') 

C 

C *>K**** If map is too large, start on next page: 
C 

ILEN=1+NINT (FLOAT (IMAXP-IMINP) /FLOAT (IRES) ) 
IF (ILEN.GT.38) WRITE (2,1060) 
1060 FORMAT ('1') 

C 

C ****** Start of actual "map" : 
C 

\ffiITE (2,1025) (HLINE(JJ),JJ=1,JLEN) 
1025 FORMAT (' ',6X,106A1) 

C 

KK = 0 

DO 200 IO_R = IMINP, IMAXP, IRES 
OLINE = BLANKL 



LL=0 

DO 300 JO_R = JMINP,JMAXP,IRES 
LL=LL+1 

IF (10 R.GE.ILIM(-1).AND.I0_R.LE.ILIM(1).AND.J0_R.GE.JLIM(1,I0_R) 
+ .AND.JO R.LE.JLIM(2,I0 R)) THEN 

KK=KK+1 

IF (MAPGNT(KK).NE.-l) THEN 

SYMBOL='*' 

ELSE 

SYMB0L='o' 

END IP 

ELSE 

SYMB0L='.' 
END IF 



C 
C 
C 
C 
C 
C 
0 
C 
C 
C 
C 
C 
C 
0 
C 
C 



IF (10 R.EQ.IO E M. AND. JO R.EQ.JO E M) THEN 

~ ~ ~ IF (SYMBOL. EQ. 



END IF 



'.') THEN 

SYMBOL='e' 
ELSE 

SYMBOL='E' 
END IF 



IF (10 R.EQ.IO B M. AND. JO R.EQ.JO B M) THEN 

- ~ " ~ "IF (SYMBOL. EQ. ' . ») THEN 



END IF 



SYMBOL='b 
ELSE 

SYMBOL='B 
END IF 



IF (10 R.EQ.IO A M. AND. JO R.EQ.JO A M) THEN 

- ~ "IF (SYMBOL. EQ.'.') 'HffiN 



— S¥MBOL='a 
ELSE 

SYMBOL='A 
END IF 



END IF 
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OLINE(LL:LL) = SYMBOL 
300 CONTINUE 

C 

TOITE (2,1040) IO_R, OLINE (1 : JLEN) 
1040 FORMAT (' ' ,I3,2X, ,A<JLEN>, '+') 
200 CONTINUE 

C 

WRITE (2,1025) (HLINE ( J J) , JJ=1 , JLEN) 

C 

C ****** RETURN TO CALLER: 
C 

RETURN ' 
END 
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File _$9SDRB5:j;0RSB0S.PEL]DISPVIS.F0R;6 (654,287,0), last revised on 
30-NQV-1987 09:26, is a 4 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 67 bytes. 

Job DISPVIS (177) queued to SP0CK_LAS2 on 3O-N0V-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 3O-N0V-1987 09:27 from queue SP0CK_LAS2. 

RRRRRRRRRR 7777777777777777777777777777777777777777777777777777 RRRRRRRRRR 
RRRRRRRRRR Digital Equipment Corporation - VAX/VMS Version V4.6 RRRRRRRRRR 
RRRRRRRRRR 7777777777777777777777777777777777777777777777777777 RRRRRRRRRR 
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•c 
c 
c 



Subroutine dispvis (visa, idn, iup, jdn, jup) 
IMPLICIT NONE 



integer * 4 
integer * 4 
integer * 2 
integer * 4 
integer * 4 
character * 1 cmd 



xdim /1023/, ydim /1023/ 
idn, iup, jdn, jup 
visa (jdn: jup, idn: iup) 

xrec, yrec, xem, yem 



c 
c 



byte 

INTEGER * 4 
INTEGER * 4 



image' (0:1023, 0:1023) 

I0_A, J0_A, I0_A_M, J0_A_M, I0_B, J0_B, I0_B_M 
JO_B__M, I0_E, JO_E, IO_E_M, J0_E_M 



c 
5 



10 



15 
c 

20 
c 

c Find 
c * 



COMMON /POSITS/ lO^A, JO^A, IO__A_^M, J0_^A_^M, IO_B, JO_B, I0_B_M, 
JO_B_M, IO_E, JO^E, IO_E_M, JO_E_M 

type ' (a, S) ' , ' Do you want the a/c visibility map displayed on 
the RAMTEK? (Y or N) »> ' 
read (*, 10) cmd 
format (a) 

IF (CMD .EQ. 'Y' .OR, CMD .EQ. 'y') THEN 
GO TO 20 

ELSE IF (CMD ,EQ. 'N' .OR- CMD .EQ. 'n') THEN 

RETURN 
ELSE 

WRITE (*, 15) 

GO TO 5 

END IF 

FORMAT ('0','**** Incorrect entry, try again.') 

continue 
« 

visible points. 



c 

c Draw 
c 



do i = 0, min (xdim, iup) 

do j =^ 0, min (ydim, jup) 

if (visa ( j , i) .le. 0) then 
image ( j , i) =1 

end if 

if (visa (j , i) .eq. -1) then 
image ( j , i) =2 

end if 
end do 
end do 

crosses at receiver and emitter position. 

xrec = IO_A 
yrec = JO_A 
xem = IO_E 
yem = JO^E 

do i = xrec - 10, xrec + 10 

image (yrec, i) = 3 
end do 

do j = yrec - 10, yrec + 10 
image (j, xrec) = 3 



! if unmasked 
! Ocean point 
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end do 

do i = xem - 10, xem - 10 

image (yem, i) = 4 
end do 

do j = yem - 10, yem + 10 

image (j , xem) = 4 
end do 

Load image to the RAMTEK 

call loadl024 (0, 0, 1024, 1024, 5, image) 

' RETURN 
end 
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File _$9$DRB5: [0RSB0S.PEL]FETCHVIS.F0R;13 (738,284,0), last revised on 
30-NOV-1987 09:26, is a 10 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 76 bytes. 

Job FETCHVIS (178) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, 
UIC [ORSBOS] , under account A6168 at priority 100, started on printer 
_SP0CK$TXA4: on 30-NOV-1987 09:27 from queue SP0CK_LAS2. 

SSSSSSSSSS 8888888888888888888888888888888888888888888888888888 SS SSSSSS S S 
SSSSSSSSSS Digi'Ear EquipmeffE-Cbrporatioff-^VAX/VMS Version V4v6 SSSSSSSSSS — 
SSSSSSSSSS 8888888888888888888888888888888888888888888888888888 SSSSSSSSSS 
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c 

Subroutine Fetchvis (visa, idn, iup, jdn, jup) 
0**********************=*^**************************^ 

c 

C Subroutine FETCHVIS - 5/5/87 C 

C Revised 6/4/87 C 

C 

C This subroutine reads in the "visibility files". C 

C VISA is the high resolution (200m) "aircraft visibility" map.C 

C The aircraft coordinates, JO_A and IO_A, and C 

C JOJB and IO_B, the emitter coordinates, JO_E and 10 Jl along C 

C with their respective heights ZAGLA and ZAGLE C 

C ' are read in as inputs from the terminal. C 

c S 



c 

C ■ Input Files: _ 

C C 

C * Terminal ... z, 

C * Unit 1 - VISA data file - Default file name is: 0 

■• } IC: [HUSS.GCD] VISAMO.DAT C 

C 

C Output Files: ^ 

° C 
C * Terminal • / \ n 

C * Unit 2 - Not opened here; received from calling routine (.sj ^ 

C Routines Used: None. 
C 

C*****************************************************************^ 

c 

character filea * 40, tstr * 11 

integer * 2 visa (jdn: jup, idn: iup) 

integer * 2 zagla, zagle, md 

integer * 4 jdn, jup, idn, iup 

C 

C ****** COmiON BLOCKS: 

Q 

integer * 4 iO_a, jO_a, iO_a_m, jO_a_m, iO_b, jO_b, iO_b_m, 
1 jO_b_m, iO_e, jO_e,' iO_e_m, jO_e_m 

common /posits/ iO_a, jO_a, iO_a_m, jO_a_m, iO_b, jO_b, iO_b_m, 
1 30_b_in, iO_e, jO_e, iO_e_m, jO_e_m 

C******************************************************************** 

c ... 
C ****** Read VISA: Visibility map for "true" aircraft position: 

C 

type ' (a, $) ' , . , 

1 ' Enter name of high resolution visibility file: 
accept 10, FILEA 
10 format (a40) 

C 



if (filea (1:2) .eq. ' ') 
1 filea = 'ic: [huss.gcd] visamo.dat' 

C 

write (2, 20) filea ^ 
20 format ('OV*" '(F) ^^*sar FILE REAB-^ROM: ',a40)-- — 

Q 

open (unit = 1, file = filea, status = 'old', 
1 f orm = 'unformatted', readonly) 

read (1) visa 
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close (unit = 1) 

c 

type ' (a, S) ' , 

1 ' Enter the aircraft (receiver) grid coordinates (x, y) : 

accept *, xac, yac 

iO_a = nint (xac) 

jO_a = nint (yac) 

type '(a, $)', . 
1 ' Enter the aircraft (receiver) height AGL in meters : 

accept *, htac 

zagla = nint (htac) 

c 

c ***** IO_B, JO_B, AND ZAGLB are just SECOND SET of variables where the 

c ***** a/c coordinates and height agl are stored. 

c 

iO b = iO_a 
30"b = jO_a 
zaglb = zagla 

C 

write (2, 40) iO_a, jO_a, zagla ^ ^ , , 

40 format ('0' /(F) ' ,4X, 'Aircraft (A) position =(' ,14, ,14, 

( .J 1 ',M6,')') 

C ****** Get emitter's position and height AGL 
C 

type '(a, $) 

1 * Enter the emitter grid coordinates (x, yj : 

accept *, xem, yem 

iO_e = nint (xem) 

jO_e = nint (yem) 

type '(a, S)', 
1 ' Enter the emitter height AGL in meters : 

accept *, htem 

zagle = nint (htem) 

c 

write (2, 50) iO_e, jO_e, zagle 
50 format 

1 ('0','(F) ',4X, 'Emitter (E) position =(' ,14, ,14, , 

2 16,')') 

n 

' Print visibility: 

C 

md = visa (jO_e, i0_e) 
if (zagle .le. md) then 

tstr = ' (Invisible) ' * 
else 

tstr = ' (Visible) ' 

end if 

c 

write (2, 60) md, tstr 
60 format ('0','(F) Masking depth at E position from A = ',15, 

1 ' meters' ,2X, All) 

C 

C ****** Return to caller: 

C 

return 

end 



NOTE: JIM 
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File $9SDRB5: [0RSB0S.PEL]FILEREAD.F0R;1 (769,271,0), last revised on 
3O-N0V-1987 09:26, is a 3 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 68 bytes. 

Job FILEREAD (179) queued to SP0CK_LAS2 on 3b-N0V-1987 09:27 by user ORSBOS, 
UIC [ORSBOS], under account A6168 at priority 100, started on printer 
_SP0CK$TXA4: on 30-NOV-1987 09:27 from queue SP0CK_LAS2. 

TTTTTTTTTT 9999999999999999999999999999999999999999999999999999 TTTTTTTTTT 
TTTTTTTTTT Digital Equipment Corporation - VAX/VMS Version V4.6 TTTTTTTTTT 
,p,p^TTTTT 9999999999999999999999999999999999999999999999999999 TTTTTTTTTT 
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subroutine FILEREAD ..^UM_RECORDS , RECORD_SIZE, FILE_ 'IE, BUFFER) 
implicit none 

integer * 2 M 

parameter (M = 180) ! second dimension of returned buffer 



WHERE: 



INTEGER*2 
INTEGER* 2 
CHARACTER*N 
INTEGER*2 



INTEGER * 2 
INTEGER * 2 
CHARACTER * 
INTEGER * 2 
integer * 2 



NUM RECORDS # OF RECORDS TO BE READ FROM THE FILE 
RECGRD_SIZE SIZE OF EACH RECORD IN BYTES 
FILE_NAME NAME OF FILE TO BE OPENED AND READ 

BUFFER (RECORD_SIZE , M) 

' THE BUFFER TO RECEIVE THE RECORDS 

READ FROM THE FILE. M>=NUM_RECORDS . 
NOTE: BUFFER MUST HAVE EXACTLY 
RECORD_SIZE ROWS. 

!# OF RECORDS TO BE READ FROM THE FILE 
! SIZE OF EACH RECORD IN BYTES 
! NAME OF FILE TO BE OPENED AND READ 



NUM_RECORDS 
RECORD_SIZE 
FILE NAME 



BUFFER (RECORD_SIZE / 2, M) 
k, rc_ov_2 



open (unit = 99, file = file_name, form = 'unformatted', 
status = 'old', readonly) 

rc_ov_2 = record_size / 2 
num records = 1 

do while (.true.) 

read (99, end = 999) (buffer (k, num_records) , k = 1, rc_ov_2) 

numrecords = num_records + 1 
end do 
continue 
close (99) 

num records = num records - 1 



return 
end 
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File $9$DRB5: [0RSB0S.PEL]GENSUM2OO.F0R;4 (779,244,0), last revised on 
30-NOV-1987 09:26, is a 20 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (OR) carriage control. The longest 
record is 80 bytes. 

Job GENSUM200 (180) queued to SP0CK_LAS2 on 3O-N0V-1987 09:27 by user ORSBOS, 
UIC [ORSBOS] , under account A6168 at priority 100, started on printer 
_SP0CK$TXA4: on 3O-N0V-1987 09:27 from queue SP0CK_LAS2. 

UUUUUUUUUU 0000000000000000000000000000000000000000000000000000 ^^^12^^55551 
UUUUUUUUUU Digi^EaT Equipmentre-orporation-^VAX/VMS Version V4t6 UUUUUUUUUU 
UUUUUUUUUU 0000000000000000000000000000000000000000000000000000 UUUUUUUUUU 



c 
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SUBROUTINE GENSUM200 rAU,EATAU,IO_A, JO_A,DISTANCE_FR _B,POraR, 
CRITMDl , CRITMD2 , THETA , VISAS , MAXVAL , CUMSUM, SUMS , IRES ,MAPCNT , 
ILIM , JLIM , IDN , lUP , JDN , JUP) 

c»* ******************************************************* *************c 

C Subroutine GENSUM200 - Revision 3/12/86, 7/6/87 C 

C . C 

C This subroutine processes the returned signal which is C 

C read in by GETTAU. This routine is called once for C 

C each value of THETA, that is, for each transmitted pulse. The C 

C results are sums of values which can be further processed when C 

C final results are desired, C 

C Basically, each point in the "sector," and outside of the C 

C minimum range of the (assumed) aircraft position, is looked at C 

C in turn as a candidate emitter location. For each point the C 

C processing is as follows. C 

C At the start of processing a pulse, a sum and a counter are C 

C both set to zero. Then, for each time when there is a received C 

C signal present, there will be a map point (not necessarilly a C 

C sector point) which would be the corresponding scattering point. C 

C If the indicated point is outside of the data base, we ignore C 

* it " 

C -If however, the point is inside of our map, we increment the C 

C counter for this candidate emitter location and add this^ C 

C scattering points contribution to the sum for this candidate C 

C emitter. Whether the candidate emitter location is a good one C 

C depends on the visibility of this scattering point from the C 

C aircraft's location. The value added is related to the masking C 

C depth of the scattering point. It is the negative of the .masking C 

C depth taken to some power: -(MD**POWER) . Actually, only masting C 

C depths which are greater (i.e., worse) than some selected value C 

C are added to the sum; if they are below (better) than this C 

C value, they are essentially set to zero. C 

C Finally, for each candidate emitter point, the above sum, C 

C which is just for this "pulse," is added to an overall sum which C 

C is the sum for the entire series of pulses. And a total counter C 

C is kept. C 

C S 

C C 

n c 

Input Files: None. C 

c c 

C Output Files: None. C 

c c 

C Routines Used: None. C 

c*************************** ****************************** *************^ 
INTEGER*2 VISAB (JDN : JUP , IDN : lUP) , MAXVAL (10000) ,MD , 
+ MAPCNT(IOOOO) ,ILIM(-1:1) , JLIM (2 , IDN : lUP) , CRITMDl ,CRITMD2 

INTEGER*4 ITAU , IO_R , JO_R , KK , IP , JP , IRES , NTAU , IO_A , JO_A , JDN , JUP , IDN , 
+ lUP 

REAL*4 pom , ONE MINUS_COSTHETA , THETA , BETA , DELX , DELY , 

SINBETA,COSBlTA, PI, RNORM,DIST, PI, CUMSUM (10000) ,SUMS(10000) , 
DISTANCE_FROM_B (10000) ,EATAU(NTAU) 

INTEGER * 4 ILL, JLL , J, I 

REAL * 4 XSP, YSP . — 

INTEGER * 2 MD_PREV, COUNT 

0 

PARAMETER ( PI = 3.14159 ) 

c**********************************************************************c 



+ 
+ 
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« 



************************** 

c 

ONE^MINUS^COSTHETA = 1.0 - COS(THETA) 

C Check each sector point, mthin resolution IRES. Candidate 

C ****** emitter is located at map coordinates (JOJl,IO_R). Locations 
C ****** are serially indexed by KK: 
C 

KK = 0 

DO 200 10 R = ILIM(-l), ILIM(l), IRES 
DO 210 JO^R = JLIM(1,I0_R), JLIM(2,I0__R) , IRES 
KK = KK + 1 
C . 

C ****** If this point lies within the minimum range of A, hits are 
C ****** not counted; this is indicated by MAPCNT(KK) to -1; go to 
C ****** next point: 
C 

IF (MAPCNT(KK).EQ.-l) GO TO 210 

C 

C ****** Calculate "absolute" transmission angle from candidate 
q ****** emitter: 

DELX=FLOAT (IO_R-IO_A) 

DELY=FLOAT ( JO_R- JO_A) 

BETA = PI + THETA + ATAN2 (DELY, DELX) 

SINBETA = SIN (BETA) 

COSBETA = COS (BETA) 

C 

C 41***** For each tau value: 
C 

SUMS(KK) = 0.0 

DO 100 ITAU = 1,NTAU 

C 

C ****** compute location of splash point in map coordinates 
C 

DIST = 0.3*EATAU(ITAU) 
RNORM = DISTANCE FROM B(KK)/DIST 

PI = DIST* (RNORM~+ 0.5) / (1.0 + RNORM*ONE MINUS_COSTHETA) 



JP = JO R + nint ( 5.0 * PI * SINBETA ) 
IP = 10 R + nint ( 5.0 * PI * COSBETA ) 



YSP = FLOAT (JO_R) + ( 5.0 * PI * SINBETA ) 
XSP = FLOAT (IO_R) +( 5.0 * PI * COSBETA ) 
JLL = INT (YSP) • 
ILL = INT (XSP) 

Q 

Q ****** If splash point is out of out map's boundaries, ignore it and 

C ****** go on and check next TAU value: 

C 

IF (JP.LT.JDN .OR- JP.GT.JUP .OR. IP.LT.IDN 
+ .OR. IP.GT.IUP) GO TO 100 

C . . 

C ****** Splash point lies within our map's boundaries; MD is masking 

C ****** depth at splash point: 

C 

C — . , , 

C ****** Since the radar beam is not a straight line but has some width 

C ****** a splash point could be any point within a strip in this beam. 

C ****** A crude way to simulate this is to look for the lowest masking 

C ****** depth within a box around the splash point. The dimensions of the 
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**\ vary depending ho\ ar out from the candidate emit ve are 
** i.e. how large the time delay is. 

IF (EATAU (ITAU) .LE. 111.0) THEN 
MD_PREV = 10000 
COUNT = 0 

DO I = MAX (ILL, IDN), MIN (ILL + 1, ILT) ! Process points in 
DO J = MAX (JLL, JDN), MIN (JLL + 1, JLT) ! 2x2 box around point 
IF (VISAB (J, I) .NE. -1) THEN 

MD = MIN (VISAB (J, I) , MD_PREV) 
ELSE 

COUNT = COUNT + 1 
END IF •■' 
' MD_PREV = MD 

END DO 

END DO ^ 
IF (COUNT .GT. 2) MD = -1 ! if sea points more than half md=-l 

ELSE IF (EATAU (ITAU) .GT. 111.0 .AND. EATAU (ITAU) .LE. 253.0) THEN 
MD_PREY = 10000 
COUNT = 0 

DO I = MAX (ILL - 1, IDN), MIN (ILL + 2, lUP) ! Process points in 
DC J = MAX (JLL - 1, JDN), MIN (JLL + 2, JUP) ! 4x4 box 
IF (VISAB (J, I) .NE. -1) THEN 

MD = MIN (VISAB (J, I) , MD_PREV) 
ELSE 

COUNT = COUNT + 1 

END IF 

MD_PREV = MD 
END DO 

END DO . J 

IF (COUNT .GT. 8) MD = -1 ! if sea points more than half md=-l 

ELSE IF (EATAU (ITAU) .GT. 253.0 .AND. EATAU (ITAU) .LE. 401 .0) THEN 
MDPREV = 10000 

COUNT =0 . . 

DO I = MAX (ILL - 2, IDN), MIN (ILL + 3, lUP) ! Process points in 
DO J = MAX (JLL - 2, JDN), MAX (JLL + 3, JUP) ! 6x6 box 
IF (VISAB (J, I) .NE. -1) THEN 

MD = MIN (VISAB (J, I) , MD_PREV) 
ELSE 

COUNT = COUNT +. 1 

END IF 
MD_PREV = MD 
ENT) DO 
END DO 

IF (COUNT .GT. 18) MD = -1 ! if sea points more than half md=-l 

ELSE 

MD_PREY = 10000 
COUNT = 0 

DO I = MAX (ILL - 3, IDN), MIN (ILL + 4, lUP) ! Process points in 
DO J = MAX (JLL - 3, JDN), MAX (JLL + 4, JUP) ! 8x8 box 
IF (VISAB (J, I) .NE. -1) THEN 

MD = MIN (VISAB (J, I) , MD_PREV) 
ELSE 

COUNT = COUNT + 1 

END IF 

MD_PREV = MD — 

END~Dir 

END DO 

IF (COUNT .GT. 32) MD = -1 ! if sea points more than half md=-l 

END IF 
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C IF SPLASH POINT IS A SEA . ^NT (I. E. MD = -1) DO NOT PROC. 
C 

IF (MD .EQ. -1) GO TO 100 

C 

C ««**** MD's falling between minus infinite and CRITMDl are treated 
C »***•* as visible (i.e. masking depth of zero). Those between CRITMDl 
C ****** and CRITMD2 are included in the Discriminant. Those above 
C ****** CRITMD2 are treated as completely invisible, i.e., not 
C ****** processed at all: 
C 

IF (MD.LE. CRITMDl) THEN 

MAPCNT (KK) =MAPCNT (KK) + 1 

ELSE IF (MD.LE. GRITMD2) THEN 

MAPCNT (KK) =MAPCNT (KK) +1 

SUMS(KK) = SUMS(KK) - FLOAT (MD)**POyfER 

MAXVAL(KK) = MAX ( MAXVAL(KK), MD ) 

END IF 

0 

100 CONTINUE 

Q 

p^^****** All TAU values processed; summary for this candidate emitter 
location (segment point #KK) : 

C 

IF (MAPCNT (KK).GT.O) THEN 

CUMSUM(KK) = CUMSUM(KK) + SUMS(KK) 

END IF 

210 CONTINUE 
200 CONTINUE 

C 

C ****** RETURN TO CALLER: 
C 

RETURN 
END 



'A'W\'V\'VW 
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File _S9$DRB5:.[0RSB0S.PEL]GETDAT.F0R;25 (781,278,0), last revised on 
3O-N0V-1987 09:26, is a 4 block sequential file owned by UIC [ORSBQS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 74 bytes. 

Job GETDAT (181) queued to SP0CK_LAS2 on 3O-N0V-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$T3CA4: 
on 3O-N0V-1987 09:28 from queue SP0CK_LAS2. 



vwmwvv 1111111111111111111111111111111111111111111111111111 

VYVYWWVY Digital Equipment Corporation - VAX/VMS Version V4.6 
WWVWYW 1111111111111111111111111111111111111111111111111111 



wvwvww 
vvwvvww 
wvwvww 
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Subroutine getdat. for — atches the scan data of run 'OC 'Jl' from 
the disk and puts it in BUFFER (-1:3000, 180) 



subroutine getdat 



if 



* 
* 



NONE 

BUFFER (-1:3000, 180), 
RECORD_SIZE, 
NUM_RECORDS, 
spec_len 

DATEj_TIME*23, 
FILE_NAME*72, 
DIR*19, 
TEST ID* 6 



include ' [orsrmb . pellnew] buff . cmn ' 



IMPLICIT 
INTEGER*2 



CHARACTER 



! BUFFER FOR FILE READ 
! RECORD SIZE IN BYTES 
! # OF BEAM POSITIONS COLLECTED 



! DATE AND TIME 

! NAME OF GENERIC DATA FILE TO READ 
! DIRECTORY NAME OF FILE 
! TEST ID # TO READ 



data RECORD_SIZE /6004/ 
data spec_len /30/ 



= 2 * NUM_SAMPLES + 4, NUM_SAMPLES = 3000 



SPEC_LEN = # OF CHARS IN PILE SPEC 

FORM THE FILE SPECIFICATION 

FILE_NAME (1 : SPEC_LEN) = DIR//TEST_ID// ' . CLUT ' 

READ THE FILE - RECORD SIZE AND FILE NAME ARE INPUTS TO FILEREAD, WHILE 
NUM RECORDS IS RETURNED ALONG WITH THE DATA IN BUFFER 



CALL FILEREAD (NUM_RECORDS, 

* RECORD_SIZE, 

* FILE_NAMB, 

* BUFFER) 



# OF AZIMUTH BEAM POSITIONS (returned) 
SIZE OF EACH RECORD (passed) 
FILE SPEC OF FILE TO BE READ (passed) 
BUFFER TO RECEIVE THE DATA (returned) 



BUFFER (-1:3000, 180) contains the complete file of scan data. 

RECORD # is in BUFFER (-1, i ) and the number 
of samples is in BUFFER(0,i). 

MITE (6, 40) FILE_NAME(1:SPEC_LEN) 

40 F0RMAT(1X, 'FINISHED READING FILE' ,1X,A<SPEC_LEN» 

WRITE (6, 45) NUM_RECORDS 
45 F0RMAT(1X, 'DATA COLLECTED ON ' ,14, ' BEAM POSITIONS. ' ,/) 



return. 



END 
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File $9$DRB5: [0RSB0S.PEL]GETTAU.F0R;35 (786,368,0), last revised on 
30-NOV-1987 09:26, is a 5 block sequential file owned by UIC [ORSBOSJ . The 
records are variable length with implied (OR) carriage control. The longest 
record is 74 bytes. 

Job GETTAU (182) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SPQCK$TXA4: 
on 3O-N0V-1987 09:28 from queue SP0CK_LAS2. 

WWW^WWVfWW 2222222222222222^2222222222222222222222222222222^ SSSL 
WWW^WWWWW Diffi^aT Eauipmeifr^orporatioir-^VAX/VMS Version V4t6 WWWWWWWWWW 

SSm 2222I2222222222222222222222222222222222222222222222 WWWWWWWWWW 
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Subroutine Gettau (delta_tau, iscan, iemrotflag, thresh, kstart, 
I thetad, maxtau, eatau, ntau) 

SUBROUTINE GETTAU May-6-1987, REVISED JUNE-9-1987, REVISED SEP-21-1987 

This subroutine reads in the real data (which is stored in the array 
buffer) and fills the output array eatau which contains time delays 
of splash points. 

integer * 2 buffer (-1:3000, 180) ! buffer for file read 

integer * 2 num^fecords, num_samples 

include 'buff.cmn' 

integer * 4 maxtau, ntau 

real * 4 eatau (maxtau) 

^vreal * 4 delta_tau, thetad, oldtau, tauv 

integer * 2 iscan, iemrotflag 

integer * 2 thresh 

3 integer * 2 kstart 

data num_samples /3000/ 

Fetch the data from the storage file. 

call getdat 

Now all of the scan data are in BUFFER (ij), j=scan no., i=sample no. 
Go through the data to get the splash points. 

Initialize time delay counter and time delay store variable 

ntau = 0 
oldtau =0.0 

Check that iscan (scan no.) is between 1 and 180. If not adjust. 

iscan = MIN (iscan, 180) 
iscan = MAX (iscan, 1) 

if (iemrotflag .eq. 1) then 

thetad = 360.0 - , x ^ 

1 ( (float (iscan - 1) / (float (num_records) - 0.5)) 

2 * 360.0 ) 

else if (iemrotflag .eq. -1) then 
thetad = 

1 ( (float (iscan - 1) / (float (num_records) - 0.5)) 

2 * 360.0 ) 
else 

type *, ' ERROR IN EMITTER ROTATION FLAG VALUE ' 

end if 

• 

: Thetad is in degrees COW from directly toward rcvr; ISAMP is the 

: sample number in increments of 0.2 microseconds (5 MHz sample rate). 

: There are 3000 point s max in a r ecord 

do isamp = kstart, num_samples 

if (buffer (isamp, iscan) .ge. thresh) then !We have a splash 

z This is the corresponding time delay. A 7.5 % correction has been 
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■ « 

•c added to the time delay, 
c 

tauv = 0.2 « 

1 float (isamp + nint ((7.5/100.0) * float (isamp))) 

c 
c 

if ( (tauv - oldtau) -ge. delta_tau ) then 
ntau = ntau + 1 
eatau (ntau) = tauv 
oldtau = tauv 
end if 
end if 
end do 

c 

return 
end 



0 
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File $9$DRB5:'[0RSB0S.PEL]G0RF.F0R;16 (790,327,0), last revised on 3O-N0V-1987 0 
9: 26, "is a 11 block sequential file owned by UIC [ORSBOS] . The records are vari 
able length with implied (CR) carriage control. The longest record is 72 bytes. 

Job GORF (183) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:28 from queue SP0CK_LAS2. 

XXXXXXXXXX 3333333333333333333333333333333333333333333333333333 XXXXXXXXXX 
XXXXXXXXXX Digital Equipment Corporation - VAX/VMS Version V4.6 XXXXXXXXXX 
XXXXXXXXXX 3333333333333333333333333333333333333333333333333333 XXXXXXXXXX 
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» • 

SUBROUTINE GORF (MAXi. . vOUNT,MMAXK, INDEX, DISC, MAPCNT, v. --^tDI, 
COORD J , KCHAR , MAXVAL , DISTANCE_FROM_E , IRES , POWER , TITLE , K_E , 
MAXPG) 

C»«***«*«*«******* ************************************************ *****C 

c c 

C Subroutine GORF - Revision 5/2/86 C 

C ' c 

C c 

C Input Files: None. C 

c c 

C Output Files: C 

c c 

C * Unit 2 - Not opened, received from calling routine. C 

C ' C 
C Routines Used: None. C 

c c 
c**********************************************************************c 

- CHARACTER SYMB0L*2, TITLE* 106 

^INTEGER*4 KK,KFLAG,MAXK,NCOUNT,MMAXK,II, JJ,nl,n2,KCHAR(4) ,IRES, 
+ K E , LCOUNT , PCOUNT , MAXPG , MAXPGT , MAXLCl , MAXLC2 

INTEGER*2 INDEX(IOOOO) , RANK, MAPCNT (10000) , CO ORDI (10000) , 
+ COORDJ (10000), MAXVAL (10000) 

REAL*4 ZK , PERCENTILE , LEVEL , DISC (10000) , DISTANCE_FROM_E (10000) , 
+ POWER 

INTEGER * 2 ILIM (-1:1), JLIM (2, 2238) 

C 

DATA MAXLCl, MAXLC2/52, 54/ 

c**********************************************************************c 
c**********************************************************************c 

C 

WRITE (2,1000) TITLE 
1000 FORMAT ('1'/' ' ,A80) 

C 

C ****** If MAXPG is 0, set to print "all": 
C 

IF- (MAXPG. EQ.O) THEN 

MAXPGT=1+NINT (0 . 5+FLOAT (MMAXK-MAXLCl) /FLOAT (MAXLC2) ) 
IF (MAXPGT. LE.O) MAXPGT=1 
ELSE 

' MAXPGT=MAXPG 

END IF • . 

C 

WRITE (2,1005) 
1005 FORMAT ('0'/' ', 

+ ' Average Maximum', 

+ ' Number Coordinates Distance ' , 

+ /' ', 'Index Rank %-tile MD**Po-v?er MD ', 
+ ' ' of MD"s (I, J) from E '/' ') 

C 

ZK = 100.0/FLOAT(MMAXK) 

C 

C ****** Go through the sector points in decreasing order of Rsoik: 
C 

KFLAG = 0 

LC0UNT=1 

PC0UNT=1 

DO 200 RANK = MMAXK, 1, -1 • 
PERCENTILE = ZK*FLOAT (RANK) 

C 

KK = INDEX (RANK+NCOUNT) 
IF (MAPCNT (KK).GT.O) THEN 
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-^/EL = 10. 0** (-DISC (KK)) -1.0 
ELSE 

LEVEL = 0.0 
END IF 

J J = COORDJ(KK) 
II = COORDI(KK) 

IF (KK.EQ.K E) THEN 

SYMBOL='Em' 
KFLAG=KFLAG+1 
ELSE IF (KK.Bq.KCHAR(l)) THEN 

SYMBOL = ' — ' 
KFLAG = KFLAG + 1 
ELSE IF (KK.EQ.KCHAR(2)) THEN 

SYMBOL = '-+' 
KFLAG = KFLAG + 1 
ELSE IF (KK.EQ.KCHAR(3)) THEN 

SYMBOL = '+-' 
KFLAG = KFLAG + 1 
ELSE IF (KK.EQ.KCHAR(4)) THEN 

SYMBOL = '++' 
^;,) KFLAG = KFLAG + 1 

ELSE 

SYMBOL=' ' 
END IF 

C 

nl = 1 + max (0,ifix (aloglO (0.1 + float (II)))) 
n2 = 1 + max (0,ifix (aloglO (0.1 + float (JJ)))) 
WRITE (2,1010) KK,RANK,PERCENTILE,LEVEL,MAXYAL(KK),MAPCNT(KK), 
+ II , JJ , SYMBOL , DISTANCE_FROM_B (KK) /lOOO . 0 
1010 FORMAT (' ',I4,3X,I4,3X,F5.1,X,F10.2,2X,I6,3X,I6,<10-nl>X, '(', 
+ I<nl>, ',I<n2>, ') ',<8-n2>X,A2,3X,F6.2) 

C 

IF ((KFLAG.EQ.4).0R. 

+ ((LCOUNT.EQ.MAXLC2).AND.(PCOUNT.EQ.MA3CPGT))) GO TO 9999 

C 

IF (PCOUNT.EQ.l) THEN 

IF (LCOUNT.EQ.MAXLCl) THEN 

WRITE (2,1015) 
r% ' LC0UNT=1 

■o" POOUNT=PCOUNT+1 

ELSE 

LCGUNT=LC0UNT+1 
END IF 

ELSE 

IF (LC0UNT.EQ.MAXLC2) THEN 

WRITE (2,1015) 

LC0UNT=1 

PC0UNT=PC0UNT+1 
ELSE 

LC0UNT=LC0UNT+1 
END IF 

END IF 

1015 FORMAT ('I'/'O', 

+ ' Average Maximum ' , 

+ ' Number Coordinates Distance ' , 

+ /' '.'Index Rank %-tile MD**Power MD ', 

' of MD"s (I, J) fromE '/' .') 

C 

200 CONTINUE 

C 
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•c 

9999 RETURN 
END 
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TPrrrnrn 444444444444 .44444444444444444444444444444.. . ±444 YTfrrrrfYY 

YYYYYYYYYY 44444444 Interactive System Design Center 44444444 YYYYYTrTYY 
TtHTnTYYY 4444444444444444444444444444444444444444444444444444 YYYYYYYYYY 
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File _$9SDRBS: [0RSB0S.PEL]HIST0C1.F0R;17 (791,348,0), last revised on 
3O-N0V-1987 09:26, is a 16 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 72 bytes. 

Job HISTOCl (184) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer SP0CK$TXA4: 
on 3O-N0V-1987 09:28 from queue SP0CK_LAS2. 

YYYYYYYYYY 4444444444444444444444444444444444444444444444444444 YYYYYYYYYY 

YYYYYYYYYY Digita3r Equipment-Corporation VAX/VMS Version V4v6 YY YYYYYm' 

YYYYYYYYYY 4444444444444444444444444444444444444444444444444444 YnYYYyYYY 
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• • SUBROUTINE HISTOCl (1. . ,MINDISC,MAXDISC, DISC, IRES, MAP. ,'SCORE, 

+ K_E,IDN,IUP,ILIM,JLIM) 
C--***""**--*****"*"*******************"* ***************************** *^ 

C Subroutine HISTOCl - Revision 3/12/86 C 

^ C 
C Input Files: None. C 

C c 

C Output Files: None. C 

C c 
C * Unit 2 - Not opened, from caller. C 

C C 

C ftoutines Used: None. C 

c c 
c**********************************************************************c 

CHARACTER OLINE*106,HLINE(106)*l,STfMBOL*l 
- INTEGER*2 MAPCNT(10000),ILIM(-1:1),JLIM(2,IDN:IUP) 
INTEGER*4 ITER , IRES , KK , IO_R , JO_R , LL , K_E , ILEN , IDN , lUP 
REAL*4 LEVEL , SCALE , MINDISC , MAXDISC , DISC (10000) , SCORE 



O DATA HLINE/106*' + V 



C 

C ****** COMMON blocks: 
C 

CHARACTER BLANKL* 106, TITLE* 106 

INTEGER*4 JMINP, JMAXP,mNP,IMAXP, JLEN 

COMMON /HIST/ BLANKL, TITLE, JMINP,JUAXP,IMINP,IMAXP,JLEN 

C 

INTEGER*4 IO_A , JO_A , IO_A_M , JO_A_M , IO_B , JO_B , IO_B_M , JO_B_M , 
+ 10 E, JO E, 10 E_M,JO_E_M 

C0MM0N~/P0STTS/ T0_A , JO_A , IO_A_M , JO_A_M , IO_B , JO_B , IO_B_M , JO_B_M , 
+ IO_E,JO_E,IO_E_M,JO_E_M 
C*********************** **************************************** *******^ 

c**********************************************************************^ 
c 

C Print page headers: 

C 

WRITE (2,1005) TITLE 
..-T005 FORMAT ('1'/' ' ,A80) 

WRITE (2,1010) ITER 
1010 FORMAT ('0'/' ', 'Cumulative location estimate after ',12, 
+ ' scans:') 

C 

C ****** Print limits of the "value" and that at the closest point 

Q ****** to the emitter: 

C 

WRITE (2,1015) MINDISC, MAXDISC 
1015 FORMAT ('0'/' ' ,4X, 'Minimum discriminant =',F7.3, '; maximum ', 
+ 'discriminant = ',F7.3) 

C 

IF (K E.6E.1) THEN 

WRITE (2,1013) DISC(K_E) 
ELSE 

WRITE (2,1045) 

— END IF — — 

1013 FORMAT ('0' ,4X, 'Discriminant of map point nearest Emitter: ',F7.3) 
1045 FORMAT ('0',4X, 'Map point nearest Emitter is not in the sector') 

C 

SCALE = 100.0/ (MAXDISC-MINDISC) 
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IF (K E.GE.l) THEN 

IF (MAPCNT(K E) .LE.O) THEN 

LEVEL=0.0 
ELSE 

LEVEL=SCALE* (DISC (K_E) -MINDISC) 
END IF 

IF (LEVEL. GE. 80.0) THEN 

SYMBOL = '#' 
ELSE IF (LEVEL. GE, 60.0) THEN 

SYMBOL = '*' 
ELSE IF (LEVEL. GE. 40. 0> THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 20.0) THEN 

SYMBOL 

ELSE 

SYMBOL = ' ' 
•END IF 



C 

WRITE (2,1020) LEVEL, SYMBOL 
U:Ti020 FORMAT ('0' ,4X, 'Level of map point nearest E (100 = max,. ', 
+ .. '0 = min): ',F6.2,' CAl,')') 
END IF 

C 

C ****** Print map score: 
C 

WRITE (2,1000) SCORE 
1000 FORMAT ('0'/' ',4X, 'Overall Map Score = ',F9.3) 

C 

0 ****** Print histogram legend: 
C 

WRITE (2,1030) 
1030 FORMAT ('0', 

+ /'O' , 'Legend: # denotes 80% <= Level <= 100%', 
+ /' ',' * denotes 60% <= Level < 805?', 

+ /' ',' + denotes 40% <= Level < 60%', 

+ /' ',' . denotes 20% <= Level < 40%', 

+ /' blank denotes 0% <= Level < 20%') 

v^'****** Print Histogram; first, the header(s): 
C 

WRITE (2,1035) JMINP , JMAXP , IRES 
1035 FORMAT ('0'/' ',8X,'(J values are from ',14,' to ',14,' by ',14, 
+ ')'/'0') 

C 

C ****** If too close to bottom of page, go to next page: 
C 

ILEN=1+NINT (FLOAT (IMAXP-IMINP) /FLOAT (IRES) ) 
IF (ILEN.GT.29) WRITE (2,1055) 
1055 FORMAT ('1') 

C 

C ****** Start of actual map: 
C 

WRITE (2,1025) (HLINE(JJ) , JJ=1 , JLEN) 
1025 FORMAT (' ',6X,106A1) — 

C . -- — 

C ****** Part of map "above" processing sector: 
C 

DO 210 IO_R = IMINP,ILIM(-1)-1,IRES 
OLINE = BLANKL 
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•c • 

C IF (10 R.EQ.IO B M) THEN 

■Q OLINE(LL:LL) = 'B' 

C END IF 

C IF (10 R.EQ.IO A M) THEN 

C V _ __ LL=1+(J0_A_M-JMINP)/IRES 

C OLINE(LL:LL)='A' 
C END IF 

C 

if (10 r.eq.io e m) then 

- - ~ i;l=i+(jo_e_m-jminp)/ires 
oline(ll:ll)='e' 

END IF 

C 

WRITE (2,1040) I0_R, 0LINE(1: JLEN) 
210 CONTINUE 
c • . ^ 

C ****** Part of map including processing sector: 

\J KK = 0 

DO 200 IO_R = ILIM(-l) , ILIM(l) , IRES 
OLINE = BLANKL 

Q 

DO 300 JO_R = JLIM(1,I0_R), JLIM(2,I0_R) , IRES 
KK = KK + 1 

C 

IF (MAPCNT(KK) .LE.O) THEN 

LEVEL=0.0 
ELSE 

LEVEL=SCALE* (DISC (KK) -MINDISC) 
END IF 

C 

IF (LEVEL. GE. 80.0) THEN 

SYMBOL = '#' 
ELSE IF (LEVEL. GE. 60.0) THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 40.0) THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 20.0) THEN 

SYMBOL = ' . ' 

ELSE 

SYMBOL = ' ' 
END IF 

C 

LL = 1+(J0_R-JMINP)/IRES 
OLINE (LL:LL) = SYMBOL 
300 CONTINUE 

C 

C IF (10 R.EQ.IO B M) THEN 

C - ~" LL=1+(J0_B_M-JMINP)/IRES 

C OLINE(LL:LL)='B' 
C END IF 

C 

C IF (10 R.EQ.IO A M) THEN 

C - EE=r+(JO_A_M-JHINP)/IRES 

C OLINE(LL:LL)='A' 

C END IF 

C 

IF (I0_R.EQ.I0_E_M) THEN 
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i+ ( JO_E_M- JMINP) /IRES 
OLINE(LL:LL)='E' 
END IF 

C 

miE (2,1040) IO_R, 0LINE(1:JLEN) 
1040 FORMAT (' ' ,I3,2X, ,A<JLEN>, '+') 
200 CONTINUE 

C 

C ****** Part of map "below" processing sector: 
C 

DO 220 IO_R = ILIM(1)+1,IMAXP,IRES 
OLINE =-BLANKL 

C 

C 'IF (10 R.EQ.IO B M) THEN 

C _ _ - LL=1+(J0_B_M-JMINP)/IRES 

C OLINE (LL:LL)='B' 

C END IF 

C - 

C ^-IF (10 R.EQ.IO A M) THEN 

C _ __ LL=1+(J0_A_M-JMINP)/IRES 

.0 OLINE(LL:LL)='A' 

.} END IF 

C 

IF (10 R.EQ.IO E M) THEN 

LL=1+ ( JO_E_M-JMINP) /IRES 
OLINE (LL:LL)='E' 
END IF 

C 

WRITE (2,1040) IO_R, OLINE (1 : JLEN) 
220 CONTINUE 

0 

C ****** "Bottom header:" 
C 

WRITE (2,1025) (HLINE ( JJ) , JJ=1 , JLEN) 

C 

C ****** Return to caller: 
C 

RETURN 
END 
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File _$9SDRB5:j;0RSB0S.PEL]HIST0C2.F0R;2O (792,349,0), last revised on 
30-NOV-1987 09:26, is a 18 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 72 bytes. 

Job HIST0C2 (185) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:29 from queue SP0CK_LAS2. 

ZZZZZZZZZZ 5555555555555555555555555555555555555555555555555555 ZZZZZZZZZZ 
ZZZZZZZZZZ Digital Equipment Corporation - VAX/VMS Version V4.6 ZZZZZZZZZZ 
ZZZZZZZZZZ 5555555555555555555555555555555555555555555556555555 ZZZZZZZZZZ 
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SUBROUTINE HIST0C2 (I ,RANK,MMAXK,MINDISC,MAXDISC,DI IRES, 
MAPCNT , RFLAG , SCORE , K_E , IDN , lUP , ILIM , JLIM) 

C Subroutine HIST0C2 - Revision 3/12/86 C 

^ C 

C r 
C Input Files: None, ^ 

C Output Files: None. ^ 
C 

C * Unit 2 - Not opened, from caller. C 

Q I C 

C Routines Used: None. ^ 

C S 
C********************************************************************** 

LOGICAL RFLAG 
• CHARACTER OLINE*106,HLINE(106)*1,SYMBOL*1 

INTEGER+2 MAPCNT(IOOOO) ,RANK(10000) ,ILIM(-1:1) , 
+ JLIM(2,IDN:IUP) 
^ INTEGER*4 ITER , MMAXK , IO_R , JO_R , KK , LL , IRES , J J , K_E , ILEN , IDN , lUP 
^ REAL*4 LEVEL , SCALE , MINDISC , MAXDISC , DISC (10000) , SCORE 

DATA HLINE/106*'+'/ 

C 

C COUMON blocks: 

C 

CHARACTER BLANKL* 106 , TITLE* 106 

INTEGER*4 JMINP, JMA!CP,IMINP,IMAXF, JLEN 

COMMON /HIST/ BLANKL.TITLE, JMINP, JMAXP,IMINP,IMAXP, JLEN 

C 

INTEGER*4 IO_A , JO_A, IO_A_M , JO_A_M, IO_B , JO_B , IO_B_M, JO_B_M, 
+ 10 E,JO E,IO E M,JO_E_M 

COMMON"/POSITS/ TO~A , JO_A , IO_A_M , JO_A_M , IO_B , JO_B , IO_B_M , JO_B_M , 
+ IO_E , JO_E , IO_E_M , JO_E_M 
C**********************************************************************^ 

c**********************************************************************^ 
c ■ . ' 

C ^cAHoiox* Print page headers; 

■ raiTE (2,1005) TITLE 
1005 FORMAT ('1'/' '.A80) 

C 

WRITE (2,1010) ITER 
1010 FORMAT ('0'/' ', 'Cumulative location estimate after ',14, 
+ ' scans : ' ) 

C 

C ****** Print limits of the "value" and that at the closest point 

C ****** to the emitter: 

C 

IF (RFLAG) THEN 

WRITE (2,1014) MMAXK 
ELSE 

WRITE (2,1015) MINDISC, MAXDISC 
END IF 

1014 FORMAT ('0'/' ' ,4X, 'Highest ranking is: ',15) 

C , 

1015 FORMAT ('07' ' ,4X, 'Minimum discriminant =' ,F7. 3, ' ; maximum , 

+ 'discriminant = ',F7.3) 

C 

IF (K_E.GE.l) THEN 
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IF (r AG) THEN 

WRITE (2,1012) RANK(K_E) 
ELSE 

raiTE (2,1013) DISC(K E) 
END IF 

ELSE 

MITE (2,1045) 
END IF 

1012 FORMAT ( '0 ' ,4X, 'Ranking of map point nearest Emitter is: ',15) 

1013 FORMAT ('0' ,4X, 'Discriminant of map point nearest Emitter: ',F7.3) 
1045 FORMAT ('0',4X,'Map point nearest Emitter is not in the sector') 

C 

C ****** Calculate and print "Level" at point closest to emitter: 
C 

IF (RFLAG) THEN 

SCALE = 100.0/FLOAT(MMAXK) 
ELSE 

SCALE = 100.0/ (MAXDISC-MINDISC) 
END IF 

C 

IF (K E.GE.l) THEN 
r-^v IF (RFLAG) THEN 

LEVEL = SCALE*RANK(K_E) 
ELSE 

IF (MAPCNT(K_E).LE.O) THEN 

LEVEL = 0.0 
ELSE 

LEVEL=SCALE* (DISC (K_E) -MINDISC) 
END IF 

END IF 

C 

IF (LEVEL. GE. 99.0) THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 95.0) THEN 

SYMBOL = 
ELSJE IF (LEVEL. GE. 85.0) THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 60.0) THEN 

• SYMBOL 

ELSE 

:'\ SYMBOL = ' ' 

END IF 

C 

WRITE (2,1020) LEVEL, SYMBOL 
1020 FORMAT ( '0 ' ,4X, 'Level of map point nearest E (100 = max, ' 
+ '0=min): ',F6.2,' (',A1,')') 
END IF 

C 

C ****** Print map score: 
C 

WRITE (2,1000) SCORE 
1000 FORMAT ('0'/' ' ,4X, 'Overall Map Score = ',F9.3) 

C 

C ****** Print histogram legend: 
C 

WRITE (2,1030) 
1030 FORMAT ('0', 

+ /'O' , 'Legend: # denotes 99% <= Level <= 10055', 
+ /' ',' * denotes 95% <= Level < 99%', 

+ /' + denotes 85% <= Level < 95%', • 

+ /' ',' . denotes 60% <= Level < 85%', 



_ > > 
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+ /' blar. denotes 0?S <= Level < 60%' 

C 

C Print Histogram; first, the header(s): 

C 

MITE (2,1035) JMINP,JmP,IRES 
1035 FORMAT ('0'/' ',8X,'(J values are from ',14,' to ',14,' by ',14, 
')7'0') 

C 

C ****** If too close to bottom of page, go to next page: 
C 

ILEN=1+NINT (FLOAT (IMAXP-IMINP) /FLOAT (IRES) ) 
IF (ILEN.GT.29) WRITE (2,1055) 
1055 FORMAT ('1') 

C 

C ****** Start of actual "map": 
C 

mTE (2,1025) (HLINE(JJ),JJ=1,JLEN) 
1025 FORMAT (' ',6X,106A1) 

C ****** Part of map "above" processing sector: 



V.:.} DO 210 IO_R = IMINP,ILIM(-1)-1,IRES 
OLINE = BLANKL 

C 

C IF (10 R.EQ.IO B M) THEN 

C _ _ - LL=i+(jo_B_M-JMINP)/IRES 

C OLINE (LL:LL)='B' 

c END n 

C 

C IF (10 R.EQ.IO A M) THEN 

C _ -_ LL=1+(J0_A_M-JMINP)/IRES 

C OLINE(LL:LL)='A' 

C END IF 



C 

IF (10 R.EQ.IO E M) THEN 

. - LL=1+ ( JO_E_M-JMINP) /IRES 

OLINE (LL:LL)='E' 
END IF 

C 

WRITE (2,1040) IO_R, OLINE (1 :JLEN) 
' 210 CONTINUE 
C 

C ****** Part of map including processing sector: 
C 

KK = 0 

DO 200 IO_R = ILIM(-l), ILIM(l), IRES 
OLINE = BLANKL 

C 

DO 300 JO_R = JLIM(1,I0_R) , JLIM (2 , IO_R) , IRES 
KK = KK + 1 

C 

IF (RFLAG) THEN 

LEVEL = SCALE * RANK(KK) 
ELSE 

IF (MAPCNT(KK) .LE.O) THEN 

LEVEL=0.0 
ELSE 

LEVEL=SCALE* (DISC (KK) -MINDISC) 
END IF 

END IF 

C 
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IF (LEVEL. GE. 99.0) TL 

SYMBOL = '#' 
ELSE IF (LEM:L.GE.9o.O) THEN 

S^lfflOL = 
ELSE IF (LEVEL. GE. 85.0) THEN 

SYMBOL = 
ELSE IF (LEVEL. GE. 60.0) THEN 

SYMBOL = ' . ' 

ELSE 

SYMBOL = ' ' 
END IF 

C 

LL=1+ ( J0_R-JMINP) /IRES ' 
OLINE(LL:LL) = SYMBOL 

c 

c WRITE OUT LEVEL VALUES TO FILE FOR 3D PLOTS 
c 

c ■ write (80, *) level 
c 

300 CONTINUE 

a 

IF (10 R.EQ.IO B M) THEN 
C • ~ ~~ LL=1+(J0_B_M-JMINP)/IRES 

C OLINE(LL:LL)='B' 
C END IF 

C 

C IF (10 R.EQ.IO A M) THEN 

C _ _- LL=1+(J0_A_M-JMINP)/IRES 

C OLINE(LL:LL)='A' 
C END IF . 

0 

IF (10 R.EQ.IO E M) THEN 

LL=1+ (J0_E_M-JMINP) /IRES 
OLINE(LL:LL)='E' 
END IF 

C 

WRITE (2,1040) IO_R, 0LINE(1: JLEN) 
1040 FORMAT (' ' ,I3,2X, ,A<JLEN>, '+') 
200 CONTINUE 

c 

Part of map "below" processing sector: 

C 

DO 220 IO_R = ILIM(1)+1,IMAXP,IRBS 
OLINE = BLANKL 

C 

C IF (10 R.EQ.IO_B_M) THEN 

C LL=1 + ( JO_B_M- JMINP) /IRES 

C ■ OLINE (LL:LL) = 'B' 

C END IF 

C 

C IF (10 R.EQ.IO_A_M) THEN 

C ~ LL=1+(J0_A M-JMINP)/IRES 

C OLINE(LL:LE)='A' 
C END IF 



C 



IF (10 R.EQ.IO E M) THEN 

LL=1+ (JO_E_M- JMINP) /IRES 
OLINE (LL:LL)='E' 
END IF 

WRITE (2,1040) IO_R, OLINE (1 : JLEN) 
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' 220 CONTINUE 
C 

C ...... "Bottom header:" 

^ raiTE (2,1025) (HLINE(JJ),JJ=1,JLEN) 
C 

C »**••* Return to caller: i 

C 

c 

c 

c 

c write (80, 500) 

c500 FORMAT (' /') 

RETURN 

END 
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File $9$DRB5: [0RSB0S.PEL]LINHIST.FOR;14 (793,288,0), last revised on 
3O-N0V-1987 09:26, is a 14 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 72 bytes. 

Job LINHIST (186) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:29 from queue SP0CK_LAS2. 

AAAAAAAAAA 666666666666666666666666666666666666666656666666§666 AAAAAAAAAA 

AAAAAAAAAA Digita±-Equipmentr-€orporation ¥AX/VMS Version V4^ AA AAAAAAAA 

AAAAAAAAAA 6666666666666666666666666666666666666666666656666666 AAAAAAAAAA 



. ' EP 0 342 529 A2 

SUBROUTINE LINHIST (T 1, TITLE, MAXK,K_E,MINDISC,MAXDIf .DISC, 
MAPCNT) 

C*M i^iHtmi^* **akJfc*********»***********5*f5«* ************* ****:is**aK ************ **C 

C C 

C Subroutine LINHIST - Revision 3/14/86-A C 

C C 

C This subroutine prints, to Unit 2, a bar graph type histo- C 

C gram of the discriminant values. C 

C The discriminant values are stored in the vector DISC, and C 

C there are MAXK values. However, if a given element of the vector C 

C MAPCNT (map counters) is less than or equal to zero, the corre- C 

C spending value of DISC is ignored. (Elsewhere there is a C 

C variable called NCOUNT which is the number of these invalid C 

C values and a variable called MMAXK which is the difference, the C 

C number of valid values.) C 

C ITER is just the number of "scans" that have been processed C 

C so far, and is used in the header line. C 

C ^ The parameters MAXDISC and MINDISC are the maximum and C 

C -minimum values from among the (valid) elements of DISC. C 

C " This bar graph starts on a new page, and takes only one page C 

C (58 lines) and is 80 characters wide. C 

— ' No external variable values are altered by this routine. C 

c c 

c c 

c c 

C Input Files: None. C 
C C 
C Output Files: None. C 

c : - c 

C * Unit 2 - Not opened, from caller. C 

C C 
C Routines Used: None. C 

c c 

0**********************************************************************0 
CHARACTER BAR (50) * 1 , POINTER (50) *1 , TITLE* 106 
INTEGER* 2 MAPCNT (10000) 

INTEGER*4 ITER , MAXK , SEGCNT (50) , ISEG , KK , BLEN , II , MAXCNT , K_E 
REAL*4 MINDISC , MAXDISC , DISC (10000) , SEGD (49) , SCALE 

0 

DATA BAR/50*'*'/ 

-\ 

C********* ********************************************************* ****C 

G 

C ****** Initialize segment boundaries and counters: 
C 

DO 100 ISEG=1,49 

SEGD (ISEG) =MINDISC+ (MAXDISC-MINDISC) * (FLOAT (ISEG) /SO . 0) 
SEGCNT (ISEG) =0 
100 CONTINUE 

SEGCNT (50) =0 

0 

C ****** Locate Emitter value; if K_E is -1, Emitter is not in the 
C ****** sector and thus has no discriminant. If MAPCNT (K_E) is -1, 
C ****** then Emitter is within RMIN of the aircraft, and has no 
C ****** discriminant. And if MAPCNT(K_E) is 0, discriminant is too 

C ****** large (negative) to use. 

C 



DO 150 ISEG=1,50 
POINTER (ISEG) =' ' 
150 CONTINUE 
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IF (K_E.GE.l) THEN 

IF (MAPCNT(K_E).Gi.O) THEN 

DO ISEG=1,49 

IF (DISC(K_E) .LT.SEGD(ISEG)) THEN 

POINTER(ISEG)='> 
GO TO 170 

END IF 

END DO 

P0INTER(5O)='>' 
END IF 

END IF 

C 

C ****** Compute the histogram: 
C 

170 DO 200 KK=1,MAXK 

IF (MAPCNT(KK).LE.O) 60 TO 200 
DO 250 ISEG=1,49 

IF (DISC(KK).LT.SEGD(ISEG)) THEN 
' ^ SEGCNT(ISEG)=SEGCNT(ISEG)+1 

GO TO 200 
END IF 

'"\2S0 CONTINUE 

SEGCNT (50) =SEGCNT (50) +1 
200 CONTINUE 

C 

C ****** Histogram #1: 
C 

C ****** Print Header: 
C 

C WRITE (2,1000) TITLE 

1000 FORMATCl'/' ',A80) 

C 

C WRITE (2,1005) ITER 

1005 FORMAT ('0'/' ' , 'Cululative Discriminant histogram after ',13, 

+ ' scans: ') 

C 

C ****** Find the maximum count from among the segments: 
C 

MAXCNT=SEGCNT(1) 
DO 350 ISEG=2,50 

MAXCNT=MAX(MAXCNT,SEGCNT(ISEG)) • 
350 CONTINUE 

C 

C ****** If no points had any hits, don't produce a bar graph: 
C 

IF (MAXCNT.EQ.O) THEN 

WRITE (2,1020) 
GO TO 9999 
END IF 

1020 FORMAT ('O'/'O' , '**** All points had no hits.') 

C 

C ****** Print the histogram: 
C 

C SCALE=50.0/FLOAT(MAXCNT) 
C 

C WRITE (2,1015) 

1015 FORMAT ('0'/-!-^ 

C 

C ISEG=1 

C BLEN=NINT (SCALE*FLOAT (SEGCNT (ISEG) ) ) 

C WRITE (2,1010) ISEG, MINDISC,SEGD (ISEG), SEGCNT (ISEG), 
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JC * POINTER (ISEG),(B II) ,II=1,BLEN) 
C 

C DO 300 ISEG=2,49 

-C BLEN=NINT (SCALE*FLOAT (SEGCNT (ISEG) ) ) 

C MITE (2,1010) ISEG, SEGD(ISEG-1),SEGD (ISEG), SEGCNT (ISEG), 

C + POINTER (ISEG) , (BAR (II) , 11=1 , BLEN) 

C 300 CONTINUE 
C 

C ISEG=50 

C BLEN=NINT (SCALE*FLOAT (SEGCNT (ISEG) ) ) 

C WRITE (2,1010) ISEG,SEGD(ISEG-1),MAXDISC,SEGCNT(ISEG), 

C + P0INTER(ISE6) , (BAR(II) ,11=1 ,BLEN) 

C 

1010 FORMAT (' ',12,': ',F7.3,' - ',F7.3,' (' ,14, ') ' ,A1, ' | ' ,50A1) 

C 

Q Histogram #2: 
C 

C ****** Print Header: 

C \ 

WRITE (2,1000) TITLE 

C 

( ) WRITE (2,1005) ITER 
6 

C ****** Print the histogram: 
0 

SCALE=1.0 

C 

WRITE (2,1015) 

C 

ISEG=1 

BLEN=NINT (SCALE*FLOAT (SEGCNT (ISEG) ) ) 
IF (BLEN. GT. 50) BLEN=50 

WRITE (2 , 1010) ISEG , MINDISC , SEGD (ISEG) , SEGCNT (ISEG) , 
+ POINTER (ISEG) , (BAR (II) , 11=1 , BLEN) 

C 

DO 400 ISEG=2,49 

BLEN=NINT (SCALB*FLOAT (SEGCNT (ISEG) ) ) 
IF (BLEN. GT. 50) BLEN=50 

WRITE (2 , 1010) ISEG , SEGD (ISEG-1) , SEGD (ISEG) , SEGCNT (ISEG) , 
+ POINTER (ISEG) , (BAR (II) , 11=1 , BLEN) 
^ -400 CONTINUE 
C 

ISEG=50 

BLEN=NINT (SCALE*FLOAT (SEGCNT (ISEG) ) ) 
IF (BLEN. GT. 50) BLEN=50 

WRITE (2 , 1010) ISEG , SEGD (ISEG-1) , MAXDISC , SEGCNT (ISEG) , 
+ POINTER (ISEG) , (BAR (II) , 11=1 , BLEN) 

C 

C ****** Return to caller: 
C 

9969 RETURN 
END 
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Pile _$9$DRB5: [0RSB0S.PEL]SC0REF.F0R;2O (977,433,0), last revised on 
3O-N0V-1987 09": 26, is a 5 block sequential file owned by UIC [ORSBOS] . The 
records are variable length with implied (CR) carriage control. The longest 
record is 72 bytes. 

Job SCOREF (188) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:36 from queue SP0CK_LAS2. 

CCCCCCCCCC 8888888888888888888888888888888888888888888888888888 CCCCCCCCCC 
CCCCCCCCCC Digital Equipment Corporation - VAX/VMS Version V4.6 CCCCCCCCCC 
CCCCCCCCCC 8888888888888888888888888888888888888888888888888888 CCCCCCCCCC 
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SUBROUTINE SCOREF (DT ,MINDISC,MAXDISC,M.^CNT,MAXK,MK' ;:,K_E, 
DISTANCE_FROM_E , RCKiT , ALPHAR , ALPHAL , SCORE) 
C*»«* *»«»**••***************•*"************""'''**''********'*******"*'"* **^ 

C Subroutine SCOREF - Revision 2/28/86 C 

C ^ 
C Input Files: None. C 

C ^ 
C Output Files: None. C 
C ^ 
C Routines Used: None. C 
0 C 
C*****^****************************************************************^ 

INTEGER*2 MAPCNT (10000) 

INTEGER*4 MMAXK,MAXK,K_E,KK 

REAL*4 DISC(IOOOO) ,MINDISC,MAXDISC, SCORE, ALPHAR, RCRIT,TEMPR, 
-+ DISTANCE_FROM_E (10000) ,TEMPL, ALPHAL 
C**********************************************************************^ 

C ... 1 

,.flv^**#*i* K E equal to -1 indicates that the emitter is not xn the 

" >>'*♦**** sector; set SCORE to a very low value, and exit: 
C 

IF (K E.LE.O) THEN 

SCORE=-1000.0 
60 TO 9999 
END IF 

0 

C ****** If there were no hits at the Emitter -position, then set. score 

0 ****** to a very low value, and exit: 

C 

IF (MAPCNT(K E).LE.O) THEN 

SCORE=- 1000.0 
GO TO 9999 
END IF 

C 

C ****** Sum component scores from each sector point other than that 

0 ******* nearest to the emitter: 

C 

SCORE=0.0 
' ^ DO 100 KK=1,MAXK 

IF (MAPCNT(KK) .LE.O.0R.KK.Eq.K_E) GO TO 100 

C 

TEMPR= (DISTANCE_FROM_E (KK) /RCRIT) 
IF (TEMPR.LT.1.0) TEMPR=1.0 
TEMPR=TEMPR* * ALPHAR 

C 

TEMPL= (DISC (K_E) -DISC (KK) ) /ALPHAL 
IF (TEMPL.GE.0.0) THEN 

SCORE=SCORE+TEMPL/TEMPR 
ELSE 

SCORE=SCORE+TEMPL*TEMPR 
END IF 

100 CONTINUE 

C 

SCORE=SCORE* (100 . 0/FLOAT (WMAXK-1) ) 

C 

C ****** Return to caller: 
C 

9999 RETURN 
END 
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File _S9$DRB5: [0RSB0S.PEL]SECT.F0R;18 (992,325,0), last revised on 3O-N0V-1987 0 
9:26, is a 28 block sequential file owned by UIC [ORSBOS] . The records are vari 
able length with implied (CR) carriage control. The longest record is 74 bytes. 

Job SECT (189) queued to SP0CK_LAS2 on 3O-N0V-1987 09:27 by user ORSBOS, UIC 
[ORSBOS], under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:36 from queue SP0CK_LAS2. 

DDDDDDDDDD 9999999999999999999999999999999999999999999999999999 DDDDDDDDDD 

DDDDDDDDDD Digitai" Equipmeirt-€orporation VAX/VMS Version V4^ DD DDDDDDDI> 

DDDDDDDDDD 9999999999999999999999999999999999999999999999999999 DDDDDDDDDD 
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SUBROUTINE SECT (Wn )_C, JO_C,DISTANCE_FR0M_E,KCHAR, .IV.AL, 
COORDI , COORD J , CUMSUM , IRES , MAPCNT , MAXK , DISTANCE_FROM_B , MMAXK , 
NCOL-NT , K_E , MAXSEC , ILIM , JLIM , IDN , lUP , JDN , JUT , SECFLG , ERR) 
C** **«»******************************************************"* ********^ 

c c 

C Subroutine SECT - Modification of sector. for (May 4, 1986) C 
C Omitt subroutines lines and proc. Instead C 

C fill arrays ilim and jlim from input. C 



C 



C 



C This subroutine generates a lov resolution "sector map." C 

C This map covers a "vedge shaped" sector of the mapped area, C 

C which corresponds to a range of azimuth angles from the C 

C aircraft's position, in which the emitter is "known" to be C 

C located; thus, this is the only portion of the mapped area C 

C which will be processed. ^ C 

C This map has points which are spaced coarser than the basic C 

C maps, specifically, one point for each IRES points, in each C 

C ^ direction, in the basic maps. Thus the number of points to be C 

C "processed is reduced by a factor of about IRES**2. C 

C The sector is described by the range of "rows" of the map C 

A (the "I" coordinates) that encompass the sector, and, for each C 

;v of these rows, the range of "columns" (the "J" coordinate) that C 

C are in the sector. Since the row and column values are taken in C 

C steps of IRES, there is the question of "where to start? "^ The C 

C low resolution map rows and columns are selected such that the C 

C aircraft's position falls on one of the low resolution map C 

C points. (Note that the emitter's position will, in general, not C 

C fall on a map point.) ^ C 

C Thus, this range of rows, and the corresponding ranges of C 

C column values, along with IRES, describes the points of the "low C 

C resolution processing sector." (Note that points within the C 

C "minimum distance," RMIN, are part of the sector and must be C 

C specially treated in other parts of the program.) A specific C 

C ordering of these points is set up. The number of points is ^ C 

C MAXK. Much of the later processing treats these points in this C 

C serial order, not as points in a two-dimensional grid. C 

C 

c 

c 

Input Files: C 

C * Terminal C 

C Output Files: ^ 

C ^ 

C * Terminal ^ 

C * Unit 2 - Not opened; from calling routines C 

c ^ 

c**********************************************************************^ 

LGGICAL*4 SECFLG 

INTEGER*2 MAXVAL (MAXSEC) , COORDI (MAXSEC) , COORD J (MAXSEC) , 
+ MAPCNT (MAXSEC) ,ILIM(-1:1) , JLIM(2,IDN:IUP) ,ITEMP 
INTEGER*2 ILEFT,IRIGHT,IBELOW, JABOVE 

INTEGER*4 KCHAR(4) ,J1,J2,I0_R,J0_R,KK, II, 12, IRES, MAXK, MMAXK, 
+ NCOUNT,K E, MAXSEC, ERR, IO_C,JO_C, IDN, lUP, JDN, JUP,JLIMiN,JLIMAX 

REAL*4 DISTA3?CE- FROM_E (MAXSEC) , GAMMA (e^h EPSILON , WIDTH , B (-2) , 
+ SLOPE (2) , DELX , DELY , GRAD , ZRES , CUMSUM (MAXSEC) , 
+ DISTANCE_FROM_B (MAXSEC), RMIN 

C 

PARAMETER (GRAD=57 . 29577951) 
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C 

C Mi,**** COMMON blocks: 
C 

CHARACTER BLANKL*106,TITLE*106 

INTEGER*4 JMINP , JMAXP , IMINP , IMAXP , JLEN 

COMMON /HIST/ BLANKL, TITLE, JMINP,JMAXP,IMINP,IMAXP,JLEN 

C 

INTEGER*4 IO_A , JO_A , IO_A_M , JO_A_M , IO_B , JO_B , IO_B_M , JO_B_M , IO_E , 
+ JO_E,IO_E_M,JO_E_M 

COMMON /POSITS/ IO_A, JO_A,IO_A_M, JO A_M,IO_B, JO_B,IO_B_M, JO_B_M, 
+ IO_E,JO_E,IO_E_M,JO_E_M 

c#***************** *************************************** *************c 
c 

ERR=0 

C 

C ****** Get emitter sector parameters from operator: 
C 

.WRITE (*,1020) 

1020 FORMAT (' '/'$', 'Enter LOP sector width (in degrees): ') 
ACCEPT *,ra:DTH 

WRITE (2,1000) WIDTH 
1000 FORMAT ('0'/' ','(S) LOP sector width = ',F7.2,' degrees') 

C 

WIDTH = WIDTH/GRAD 

C 

WRITE (*,1030) 

1030 FORMAT (' '/'$', 'Enter angle CCW from true LOP to sector edge ', ' 
+ ' (in degrees) : ') 
ACCEPT *,EPSILON 

C 

WRITE (2,1040) EPSILON 
1040 FORMAT ('0','(S) Angle CCW from true LOP to sector edge = ', 
+ F7.2,' degrees') 

C 

EPSILON = EPSILON/GRAD 

C 

C ****** Calculate sector boundaries lines: 
C 

GAMMA (0) = ATAN2 (FLOAT (J0_E-J0_C) , FLOAT (I0_E-I0_C) ) 

GAMMA (2) = GAMMA (0) + EPSILON 

GAMMA (1) = GAMMA (2) - WIDTH 
C CALL LINES (GAMMA, SLOPE, B,JDN,JTJP,J0_C,I0_C) 
C 

C ****** Determine sector boundaries: 
C 

C CALL PROC (I0_C,IDN,IUP,JDN,JT3P,GAMMA,ILIM,JLIM, SLOPE, B) 
C 

C Get grid coordinates of center of square sector 
C 

type *, ' Enter the grid coordinates of the center of the 
1 square sector (col , row) : ' 
accept *, i center, j center 

C 

C Get distance of end points from center of square sector 

C — 

type *, 

1 ' Enter number of grid points to the right of center: ' 
accept *, iright 
type *, 
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* 

1 ' Enter number of , d points to the left of center 
accept *, ileft 

type *, ' Enter number of grid points above center: ' 
accept *, j above 

type *, ' Enter niimber of grid points below center: ' 
accept *, j below 

C 

C Fill arrays ilim and jlim 
C 

ilim (-1) = max (icenter - ileft, idn) 
ilim (1) = min (icenter + iright, iup) 

C 

do i = ilim (-1) , ilim (1) 

jlim (1, i) = max (jdn, j center - j below) 

jlim (2, i) = min (jup, j center + j above) 
end do 

C 

C ****** Get desired "low resolution map" resolution from operator: 
miTE (*,1060) 

--.1060 FORMAT (' '/'$', 'Enter map resolution (n X 0.2 km) : n = ') 
.) ACCEPT *,IRBS 

WRITE (2,1070) IRES 
1070 FORMAT ('0','(S) Map resolution (n X 0.2 km): n = ',12) 

C 

ZRES = FLOAT (IRES) 

C 

C ****** Compute "adjusted I limits" (Rows) : 
C 

ITEMP = 10 C + IRES*NINT( (ILIM(-l) - IO_C)/ZRES ) 
IF (ITEMP. LT.ILIM(-l)) THEN 

ILIM(-1)=ITEMP+IRES 
ELSE 

ILIM(-1)=ITEMP 
END IF 

C 

ITEMP = IO_C + IRES*NINT( (ILIM(l) - IO_C)/ZRES ) 
IF (ITEMP. GT. ILIM (1)) THEN 

ILIM(1)=ITEMP-IRES 
ELSE 

ILIM(1)=ITEMP 
END IF 

C 

C ****** Compute "adjusted J limits" (Columns): 
C 

JLIMIN=JUP 
JLIMAX=JDN 

C 

DO 100 10 R = ILIM(-l), ILIM(l), IRES 

JLIM(1,I0"R) = JO_C + IRES*NINT( (JLIM(1 ,10_R) - J0_C) / ZRES ) 
IF (JLIM(T,IO_R).LT.JDN) JLIM(1,I0_R) = JLIM(I,IO_R) + IRES 

C 

JLIMIN=MIN(JLIMIN, JLIM(1 ,IO_R)) 

C 

JLIM (2, 10 R) = JO_C + IRES*NINT( (JLIM(2,I0_R) - JO_C) / ZRES) 
IF (JLIM(2,I0_R).6T.JW) JLIM(2,I0_R) = JLIM(2,I0_R) - IRES 

C — - 

JLIMAX=MAX ( JLIMAX , JLIM (2 , IO_R) ) 
100 CONTINUE 

C 

' C ****** Find the closest "map point" to the true aircraft position: 
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-C 



10 A M = IO_C + IRES*»iNT( (IO_A - IO_C)/ZRES ) 
IF" (To A M.LT.IDN) IO_A_M = IO_A_M * IRES 
IF (I0;;;A_M.GT.IUP) I0_A_M = IO_A_M - IRES 

c 

JO A M = JO C + IRES*NINT( (JO_A - JO_C)/ZRES ) 
IF" (JO A M.LT.JDN) JO_A_M = JO_A_M + IRES 
IF (J0"a"M.GT.JTJP) J0_A_M = JO_A_M - IRES 

C 

IF (IO_A_M.NE.IO_A.0R.JO_A_M.NE.JO_A) WRITE (2,1085) IO_A_M, JO_A_M 
1085 FORMAT ('0','(S) Coordinates of map point nearest Aircraft are', 
' (',14,', ',14,')') 

C 

C ****** Find the closest "map point" to the assumed aircraft position: 
C 

10 B M = 10 C + IRES*NINT( (IO_B - IO_G)/ZRES ) 
IF" (To B M.LT.IDN) IO_B_M = IO_B_M + IRES 
IF (I0~BlM.GT.II3P) IO_B_M = IO_B_M - IRES 

C 

JO B M = JO C + IRES*NINT( (JO_B - JO_C)/ZRES ) 
IF" (JO B M.LT.JDN) JO_B_M = JO_B_M + IRES 
O IF (JO3B~M.6T.JUP) JO_B_M = JO_B_M - IRES 

"6 

IF (IO_B_M.NE.IO_B.0R.JO_B_M.NE.JO_B) WRITE (2,1090) IO_B_M, JO_B_M 
1090 FORMAT ('0','(S) Coordinates of map point nearest Aircraft" are', 
' (',14,', ',14,')') 

C 

C ****** Find the closest "map point" to the Emitter: 
C 

10 E M = IO_C + IRES*NINT( (IO_E - IO_C)/ZRES ) 
IF~(TO E_M.LT.IDN) IO_E_M = IO_E_M + IRES 
lip (IO~E_M.GT.IUP) IO_E_M = IO_E_M - IRES 

C 

JO E M = JO_C + IRES*NINT( (JO_E - JO_C)/ZRES ) 
IF~(JO E M.LT.JDN) JO_E_M = JO_E_M + IRES 
IF (J03;E~M.GT.JTJP) J0_B M = JO_E_M - IRES 

C 

WRITE (2,1080) IO_E_M, JO_E_M 
1080 FORMAT ('0','(S) Coordinates of map point nearest Emitter are', 
...^ H. ' (',14, ',',14,')') 

C ****** Compute limits for plots: 
C 

IF (SECFLG) THEN 

C IMINP=IO C+IRES*NINT( (IDN-IO_C) /ZRES ) 

C IF (IMINP.LT.IDN) IMINP = IMINP + IRES 
C 

C IMA£P=IO C+IRES*NINT( (IUP-IO_C) /ZRES ) 

C IF (IMAXP.GT.IUP) IMAXP = IMAXP - IRES 
C 

C JMINP=JO C+IRES*NINT( (JDN- JO_C) /ZRES ) 

C IF (JMINP.LT.JDN) JMINP = JMINP + IRES 
C 

C JMAXP=JO_C+IRES*NINT( ( JUP- JO_C) /ZRES ) 

C IF (JMAXP.GT.JUP) JMAXP = JMAXP - IRES 



C 



-DC[NP=ILIU4-i) +IRES*NIN3:4-4IDN-ILIM(-1).) /ZRES) 
IF (IMINP.LT.IDN) IMINP = IMINP + IRES 

IMAXP=ILIM(1)+IRES*NINT( (IUP-ILIM(1))/ZRES ) 
IF (IMAXP.GT.IUP) IMAXP = IMAXP - IRES 
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JMINP=JLiMIN+IRES*NINT( (JDN-JLIMIN) /ZRES ) 
IF (JMINP.LT.JDN) JMINP = JMINP * IRES 

"C 

JMAXP=JLIMAX+IRES*NINT( (JUP- JLIMAX) /ZRES ) 

IF (JMAXP.GT.JUP) JMAXP = JMAXP - IRES 
» ELSE 

IMINP=ILIM(-1) 
C IF (IMINP.GT.IO_A_M) IMINP=IO_A_M 

C IF (IMINP.GT.IO_B_M) IMINP=IO_B_M 

IF (IMINP.GT.IO_B_M) IMINP=IO_E_M 

C 

IMAXP=ILIM(1) 

C '• IF (IMAXP.LT.IO_A_M) IMAXP=IO_A_M 

C IF (IMAXP.LT.IO_B_M) IMAXP=IO_B_M 

IF (IMAXP.LT.IO_E_M) IMAXP=IO_E_M 

C 

JMINP=JLIMIN 

C IF ( JMINP. GT.JO_A_M) JMINP=JO_A_M 

C IF ( JMINP. GT.JO_B_M) JMINP=JO_B_M 

IF (JMINP. GT.JO_E_M) JMINP=JO_E_M 

JMAXP=JLIMAX 

C IF ( JMAXP. LT.JO_A_M) JMAXP=JO_A_M 

C IF ( JMAXP. LT.JO_B_M) JMAXP=JO_B_M 

IF ( JMAXP. LT.JO_E_M) JMAXP=JO_E_M 
END IF 

C 

JLEN=1+NINT ( (JMAXP- JMINP) /ZRES) 

C ... 

C ****** Locate 4 points around "true" emitter position: 

C 

IF (10 E.EQ.IO E M) THEN 

I1=I0_B_M 
I2=I0_E_M 
ELSE IF (10 B.LT.IO E M) THEN 

I1=I0_E_M-IRES 
I2=I0_E_M 

ELSE 

I1=I0_E_M 
I2=I0_E_M+IRES 
END IF ■ 

C 

IF (JO E.EQ.JO E M) THEN 

J1=J0_E_M 
J2=J0_E_M 
ELSE IF (JO E.LT.JO E M) THEN 

J1=J0_E_M-IRES 
J2=J0_E_M 

ELSE 

J1=J0_E_M 
J2=J0_E_M+IRES 
END IF 

C 

C ****** Mark emitter position and those around it: 
C 

K E=-l 

DO 220 KK=1,4 
KCHAR(KK)=-1 
220 CONTINUE 

C 
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KK = 0 

DO 200 IO_R = ILIM(-1J, ILIM(l) , IRES 
DO 210 JO_R = JLIM(1,I0_R), JLIM(2,I0_R) , IRES 
KK = KK 1 

C 

IF (I0_R.EQ.I0_E_M .and. J0_R.EQ. J0_E_M) K E = KK 

C 

IF (I0_R.EQ.I1 .and. J0_R.EQ.J1) 

IF (I0_R.EQ.I1 .and. J0_R.EQ.J2) 

IF (I0_R.EQ.I2 .and. J0_R.EQ.J1) 

IF (I0_R.EQ.I2 .and. J0_R.EQ.J2) 
210 CONTINUE 
200 CONTINUE 

C 

C ****** Set elements of arrays that use serial ordering: 
C 

KK = 0 

xDO 300 IO_R = ILIM(-l), ILIM(l) , IRES 
DO 310 JO_R = JLIM(1,I0_R), JLIM(2,I0_R) , IRES 

C 

KK = KK+1 ~ 

IF: (KK.GT.MAXSEC) THEN 

ERR=1 
GO TO 9999 
END IF 

C 

COORDJ(KK) = JO_R 
COORDI(KK) = 10 R 

C 

DELX = IO_R - IO_E 
DELY = JO R - JOE 

DISTANCE_FR0M_E(KK) = 200.0*SQRT(DELX**2 + DELY**2) 

C 

DELX = IO_R - IO_B 
DELY = JO R - JO_B 

DISTANCE_FR0M_B(KK) = 0.2*SQRT(DELX**2 + DBLY**2) 

C 

MAXVAL(KK) = 0 
CUMSUMCKK) = 0.0 

IF (DISTANCE_FROM_B(KK).LT.RMIN) THEN 

MAPCNT(KK)=-1 

ELSE 

MAPCNT(KK)'= 0 
MMAXK=MMAXK+1 

END IF 

310 CONTINUE 
300 CONTINUE 

C 

MAXK = KK 
NCOUNT=MAXK-MMAXK 

C 

C ****** Return to caller: 
C 

9999 RETURN 

END 



KCHAR(l) = KK 

KCHAR(2) = KK 

KCHAR(3) = KK 

KCHAR(4) = KK 
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File $9SDRB5:"[0RSB0S.PEL3S0RT.F0R;12 (1014,340,0), last revised on 30-NOV-1987 
09:267 is a 5 block sequential file owned by UIC [ORSBOS] . The records are vari 
able length with implied (CR) carriage control. The longest record is 72 bytes. 

Job SORT (190) queued to SP0CK_LAS2 on 30-NOV-1987 09:27 by user ORSBOS, UIC 
[ORSBOS] , under account A6168 at priority 100, started on printer _SP0CK$TXA4: 
on 30-NOV-1987 09:36 from queue SP0CK_LAS2. 

EEEEEEEEEE OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO EEEEEEEEEE 
EEEEEEEEEE Digital Equipment Corporation - VAX/VMS Version V4.6 EEEEEEEEEE 
EEEEEEEEEE OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO EEEEEEEEEE 
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. •• 

SUBROUTINE S0RT(INDE: :0UNT, RANK, MAXK.MMAXK, DISC, MAPC . 
C**»**«****** ************************* *******************''****'********^ 

c ^ 
"C Subroutine SORT - Revision 2/10/86 C 

^ C 
C p 
C Input Files: None. C 

C J 
C Output Files: None. C 

C S 
C Routines Used: None. C 

c*********************************************************** ****** *****^ 

INTEGER*4 NCOUNT,ITEMP,MAXK,MMAXK,KK, JJ,IPASS, JJPl 
INTEGER*2 INDEX(IOOOO) ,RANK(10000) ,MAPCNT( 10000) 
REAL*4 DISC (10000) ,VAL1,VAL2 
C**********************************************************************^ 

c**********************************************************************^ 
c 

DO 100 KK = 1,MAXK 
INDEX(KK) = KK 
. ' 100 CONTINUE 
C ' 

DO 200 IPASS = 1,MAXK-1 
DO 300 JJ = 1,MAXK-IPASS 
JJP1=JJ+1 

C 

VALl = DISC (INDEX (JJ)) 
VAL2 = DISC (INDEX (JJPl)) 

C 

IF (VAL1.GT.VAL2) THEN 

ITEMP = INDEX (JJ) 
INDEX(JJ) = INDBX(JJPl) 
INDEX (JJPl) = ITEMP 
END IF 

300 CONTINUE 
200 CONTINUE 

c • 

DO 400 JJ = 1,MAXK 
KK = INDEX (J J) ' 
RANK(KK) = JJ 
400 CONTINUE 

C 

C ****** Since the NCOUNT points with MAPCNT's of -1 should have had 
C ****** the lowest rankings, "squeeze them out" by reducing all other 
C ****** point's rankings by NCOUNT, and set the "deleted" point's 
C ****** rankings to zero (which is not otherwise used) : 
C 

DO KK = 1,MAXK 

IF (MAPCNT(KK).EQ.-l) THEN 

RANK(KK) = 0 
ELSE 

RANK(KK) = RANK(KK) - NCOUNT 
END IF 

END DO 

C 

C ****** RETURN TO CALLER: 
C 

RETURN 
END 
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